diff --git a/.gitignore b/.gitignore index fcfcf07..e02539f 100644 --- a/.gitignore +++ b/.gitignore @@ -34,6 +34,8 @@ src/libasr/wasm_visitor.h src/libasr/config.h fa fa2 +c_o +llvm_o */bin/lc *vscode* integration_tests/test-* diff --git a/build.sh b/build.sh index cf3eb34..b0e89bc 100755 --- a/build.sh +++ b/build.sh @@ -5,6 +5,7 @@ set -ex python src/libasr/asdl_cpp.py src/lc/LC.asdl src/lc/ast.h python src/libasr/asdl_cpp.py src/libasr/ASR.asdl src/libasr/asr.h python src/libasr/wasm_instructions_visitor.py +python src/libasr/intrinsic_func_registry_util_gen.py (cd src/lc/parser && re2c -W -b tokenizer.re -o tokenizer.cpp) (cd src/lc/parser && bison -Wall -d -r all parser.yy) diff --git a/integration_tests/CMakeLists.txt b/integration_tests/CMakeLists.txt index c7b8ea8..b2789b7 100644 --- a/integration_tests/CMakeLists.txt +++ b/integration_tests/CMakeLists.txt @@ -208,7 +208,7 @@ RUN(NAME array_10.cpp LABELS gcc llvm) RUN(NAME array_11.cpp LABELS gcc llvm) RUN(NAME array_12.cpp LABELS gcc llvm) RUN(NAME array_13.cpp LABELS gcc llvm) -RUN(NAME array_14.cpp LABELS gcc llvm) +RUN(NAME array_14.cpp LABELS gcc llvm NOFAST) # promote_allocatable_to_nonallocatable pass cannot be applied RUN(NAME array_15.cpp LABELS gcc llvm) RUN(NAME array_16.cpp LABELS gcc llvm) RUN(NAME array_17.cpp LABELS gcc llvm) diff --git a/integration_tests/array_14.cpp b/integration_tests/array_14.cpp index b9fbf1f..d447804 100644 --- a/integration_tests/array_14.cpp +++ b/integration_tests/array_14.cpp @@ -9,13 +9,13 @@ int main() { xt::xtensor array_const_1 = {{-14, 3, 0, -2}, {19, 1, 20, 21}}; xt::xtensor_fixed> i23_shape = {4, 2}; -std::cout<< array_const_1 << std::endl; +std::cout<< array_const_1 << "\n"; array_const_1.reshape(i23_shape); -std::cout << array_const_1 << std::endl; -std::cout << array_const_1(0, 0) << " " << array_const_1(0, 1) << std::endl; -std::cout << array_const_1(1, 0) << " " << array_const_1(1, 1) << std::endl; -std::cout << array_const_1(2, 0) << " " << array_const_1(2, 1) << std::endl; -std::cout << array_const_1(3, 0) << " " << array_const_1(3, 1) << std::endl; +std::cout << array_const_1 << "\n"; +std::cout << array_const_1(0, 0) << " " << array_const_1(0, 1) << "\n"; +std::cout << array_const_1(1, 0) << " " << array_const_1(1, 1) << "\n"; +std::cout << array_const_1(2, 0) << " " << array_const_1(2, 1) << "\n"; +std::cout << array_const_1(3, 0) << " " << array_const_1(3, 1) << "\n"; if( array_const_1(0, 0) != -14 ) { exit(2); } diff --git a/run_tests.py b/run_tests.py index f824719..2e686a7 100755 --- a/run_tests.py +++ b/run_tests.py @@ -10,7 +10,7 @@ def single_test(test, verbose, no_llvm, skip_run_with_dbg, skip_cpptranslate, update_reference, - no_color, specific_backends=None, excluded_backends=None): + verify_hash, no_color, specific_backends=None, excluded_backends=None): filename = test["filename"] def is_included(backend): return test.get(backend, False) \ diff --git a/src/lc/clang_ast_to_asr.cpp b/src/lc/clang_ast_to_asr.cpp index f984155..f7d6677 100644 --- a/src/lc/clang_ast_to_asr.cpp +++ b/src/lc/clang_ast_to_asr.cpp @@ -1229,8 +1229,8 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(array, i + 1, "lbound", al); - index.m_right = ASRUtils::get_bound(array, i + 1, "ubound", al); + index.m_left = PassUtils::get_bound(array, i + 1, "lbound", al); + index.m_right = PassUtils::get_bound(array, i + 1, "ubound", al); index.m_step = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, index.loc, 1, ASRUtils::TYPE(ASR::make_Integer_t(al, index.loc, 4)))); array_section_indices.push_back(al, index); @@ -1252,8 +1252,8 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitorbase.loc; - index.m_left = ASRUtils::get_bound(array, i + 1, "lbound", al); - index.m_right = ASRUtils::get_bound(array, i + 1, "ubound", al); + index.m_left = PassUtils::get_bound(array, i + 1, "lbound", al); + index.m_right = PassUtils::get_bound(array, i + 1, "ubound", al); index.m_step = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, index.loc, 1, ASRUtils::TYPE(ASR::make_Integer_t(al, index.loc, 4)))); array_section_indices.push_back(al, index); @@ -1400,7 +1400,7 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(*shape_arg) ) { @@ -1432,8 +1432,8 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(ASRUtils::IntrinsicScalarFunctions::Exp), + tmp = ASRUtils::make_IntrinsicElementalFunction_t_util(al, Lloc(x), + static_cast(ASRUtils::IntrinsicElementalFunctions::Exp), args.p, args.size(), 0, ASRUtils::expr_type(args.p[0]), nullptr); } else if( sf == SpecialFunc::Pow ) { if( args.size() != 2 ) { @@ -1442,20 +1442,20 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(ASRUtils::IntrinsicScalarFunctions::Sqrt), + tmp = ASRUtils::make_IntrinsicElementalFunction_t_util(al, Lloc(x), + static_cast(ASRUtils::IntrinsicElementalFunctions::Sqrt), args.p, args.size(), 0, ASRUtils::expr_type(args.p[0]), nullptr); } else if( sf == SpecialFunc::Abs ) { - tmp = ASRUtils::make_IntrinsicScalarFunction_t_util(al, Lloc(x), - static_cast(ASRUtils::IntrinsicScalarFunctions::Abs), + tmp = ASRUtils::make_IntrinsicElementalFunction_t_util(al, Lloc(x), + static_cast(ASRUtils::IntrinsicElementalFunctions::Abs), args.p, args.size(), 0, ASRUtils::expr_type(args.p[0]), nullptr); } else if( sf == SpecialFunc::Sin ) { - tmp = ASRUtils::make_IntrinsicScalarFunction_t_util(al, Lloc(x), - static_cast(ASRUtils::IntrinsicScalarFunctions::Sin), + tmp = ASRUtils::make_IntrinsicElementalFunction_t_util(al, Lloc(x), + static_cast(ASRUtils::IntrinsicElementalFunctions::Sin), args.p, args.size(), 0, ASRUtils::expr_type(args.p[0]), nullptr); } else if( sf == SpecialFunc::Cos ) { - tmp = ASRUtils::make_IntrinsicScalarFunction_t_util(al, Lloc(x), - static_cast(ASRUtils::IntrinsicScalarFunctions::Cos), + tmp = ASRUtils::make_IntrinsicElementalFunction_t_util(al, Lloc(x), + static_cast(ASRUtils::IntrinsicElementalFunctions::Cos), args.p, args.size(), 0, ASRUtils::expr_type(args.p[0]), nullptr); } else if( sf == SpecialFunc::AMax ) { if( args.size() > 1 && args.p[1] != nullptr ) { @@ -1510,36 +1510,44 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(*args.p[0]) ) { ASR::ArrayConstant_t* array_constant = ASR::down_cast(args.p[0]); - size_t target_rank = ASRUtils::extract_n_dims_from_ttype( - ASRUtils::expr_type(assignment_target)); - if( array_constant->n_args != target_rank ) { - throw std::runtime_error("Assignment target must be of same rank as the size of the shape array."); - } - - Vec alloc_args; alloc_args.reserve(al, 1); - ASR::alloc_arg_t alloc_arg; alloc_arg.loc = Lloc(x); - alloc_arg.m_a = assignment_target; - alloc_arg.m_len_expr = nullptr; alloc_arg.m_type = nullptr; - Vec alloc_dims; alloc_dims.reserve(al, target_rank); - for( size_t i = 0; i < target_rank; i++ ) { - ASR::dimension_t alloc_dim; - alloc_dim.loc = Lloc(x); - alloc_dim.m_length = array_constant->m_args[i]; - alloc_dim.m_start = ASRUtils::EXPR(ASR::make_IntegerConstant_t( - al, Lloc(x), 0, ASRUtils::TYPE(ASR::make_Integer_t(al, Lloc(x), 4)))); - alloc_dims.push_back(al, alloc_dim); - } - alloc_arg.m_dims = alloc_dims.p; alloc_arg.n_dims = alloc_dims.size(); - alloc_args.push_back(al, alloc_arg); - current_body->push_back(al, ASRUtils::STMT(ASR::make_Allocate_t(al, Lloc(x), - alloc_args.p, alloc_args.size(), nullptr, nullptr, nullptr))); - tmp = nullptr; - is_stmt_created = true; + a_m_args = array_constant->m_args; + n_m_args = array_constant->n_args; + } else if( ASR::is_a(*args.p[0]) ) { + ASR::ArrayConstructor_t* array_constructor = ASR::down_cast(args.p[0]); + a_m_args = array_constructor->m_args; + n_m_args = array_constructor->n_args; } else { throw std::runtime_error("Only {...} is allowed for supplying shape to xt::empty."); } + + size_t target_rank = ASRUtils::extract_n_dims_from_ttype( + ASRUtils::expr_type(assignment_target)); + if( n_m_args != target_rank ) { + throw std::runtime_error("Assignment target must be of same rank as the size of the shape array."); + } + + Vec alloc_args; alloc_args.reserve(al, 1); + ASR::alloc_arg_t alloc_arg; alloc_arg.loc = Lloc(x); + alloc_arg.m_a = assignment_target; + alloc_arg.m_len_expr = nullptr; alloc_arg.m_type = nullptr; + Vec alloc_dims; alloc_dims.reserve(al, target_rank); + for( size_t i = 0; i < target_rank; i++ ) { + ASR::dimension_t alloc_dim; + alloc_dim.loc = Lloc(x); + alloc_dim.m_length = a_m_args[i]; + alloc_dim.m_start = ASRUtils::EXPR(ASR::make_IntegerConstant_t( + al, Lloc(x), 0, ASRUtils::TYPE(ASR::make_Integer_t(al, Lloc(x), 4)))); + alloc_dims.push_back(al, alloc_dim); + } + alloc_arg.m_dims = alloc_dims.p; alloc_arg.n_dims = alloc_dims.size(); + alloc_args.push_back(al, alloc_arg); + current_body->push_back(al, ASRUtils::STMT(ASR::make_Allocate_t(al, Lloc(x), + alloc_args.p, alloc_args.size(), nullptr, nullptr, nullptr))); + tmp = nullptr; + is_stmt_created = true; } else if (sf == SpecialFunc::TorchEmpty) { if( args.size() < 1 ) { // Ignore the last two throw std::runtime_error("torch::empty must be provided with shape."); @@ -1548,29 +1556,36 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(*args.p[0]) ) { ASR::ArrayConstant_t* array_constant = ASR::down_cast(args.p[0]); - - Vec empty_dims; empty_dims.reserve(al, array_constant->n_args); - for( size_t idim = 0; idim < array_constant->n_args; idim++ ) { - ASR::dimension_t empty_dim; - empty_dim.loc = Lloc(x); - empty_dim.m_start = ASRUtils::get_constant_zero_with_given_type( - al, ASRUtils::TYPE(ASR::make_Integer_t(al, Lloc(x), 4))); - empty_dim.m_length = nullptr; - empty_dims.push_back(al, empty_dim); - } - ASR::ttype_t* type = ASRUtils::TYPE(ASR::make_Array_t(al, Lloc(x), - ASRUtils::extract_type(ASRUtils::expr_type(assignment_target)), - empty_dims.p, empty_dims.size(), ASR::array_physical_typeType::DescriptorArray)); - type = ASRUtils::TYPE(ASR::make_Allocatable_t(al, Lloc(x), type)); - ASR::down_cast( - ASR::down_cast(assignment_target)->m_v)->m_type = type; - tmp = nullptr; - is_stmt_created = false; + a_m_args = array_constant->m_args; + n_m_args = array_constant->n_args; + } else if( ASR::is_a(*args.p[0]) ) { + ASR::ArrayConstructor_t* array_constructor = ASR::down_cast(args.p[0]); + a_m_args = array_constructor->m_args; + n_m_args = array_constructor->n_args; } else { throw std::runtime_error("Only {...} is allowed for supplying shape to xt::empty."); } + + Vec empty_dims; empty_dims.reserve(al, n_m_args); + for( size_t idim = 0; idim < n_m_args; idim++ ) { + ASR::dimension_t empty_dim; + empty_dim.loc = Lloc(x); + empty_dim.m_start = ASRUtils::get_constant_zero_with_given_type( + al, ASRUtils::TYPE(ASR::make_Integer_t(al, Lloc(x), 4))); + empty_dim.m_length = nullptr; + empty_dims.push_back(al, empty_dim); + } + ASR::ttype_t* type = ASRUtils::TYPE(ASR::make_Array_t(al, Lloc(x), + ASRUtils::extract_type(ASRUtils::expr_type(assignment_target)), + empty_dims.p, empty_dims.size(), ASR::array_physical_typeType::DescriptorArray)); + type = ASRUtils::TYPE(ASR::make_Allocatable_t(al, Lloc(x), type)); + ASR::down_cast( + ASR::down_cast(assignment_target)->m_v)->m_type = type; + tmp = nullptr; + is_stmt_created = false; } else if (sf == SpecialFunc::TorchFromBlob) { if( args.size() < 2 ) { // Ignore the last one throw std::runtime_error("torch::from must be provided with C array and its shape."); @@ -1636,7 +1651,12 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor args_with_list; args_with_list.reserve(al, 2); + args_with_list.push_back(al, callee); + args_with_list.push_back(al, args[0]); + tmp = ASR::make_Expr_t(al, Lloc(x), ASRUtils::EXPR(ASR::make_IntrinsicElementalFunction_t(al, Lloc(x), + static_cast(ASRUtils::IntrinsicElementalFunctions::ListReserve), args_with_list.p, + args_with_list.size(), 0, nullptr, nullptr))); is_stmt_created = true; } else { throw std::runtime_error("Only printf and exit special functions supported"); @@ -1676,7 +1696,7 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor void flatten_ArrayConstant(ASR::expr_t* array_constant) { if( !ASRUtils::is_array(ASRUtils::expr_type(array_constant)) ) { return ; } - LCOMPILERS_ASSERT(ASR::is_a(*array_constant)); - ASR::ArrayConstant_t* array_constant_t = ASR::down_cast(array_constant); + LCOMPILERS_ASSERT(ASR::is_a(*array_constant)); + T* array_constant_t = ASR::down_cast(array_constant); Vec new_elements; new_elements.reserve(al, array_constant_t->n_args); for( size_t i = 0; i < array_constant_t->n_args; i++ ) { - flatten_ArrayConstant(array_constant_t->m_args[i]); - if( ASR::is_a(*array_constant_t->m_args[i]) ) { - ASR::ArrayConstant_t* aci = ASR::down_cast(array_constant_t->m_args[i]); + if( ASR::is_a(*array_constant_t->m_args[i]) ) { + flatten_ArrayConstant(array_constant_t->m_args[i]); + } else { + flatten_ArrayConstant(array_constant_t->m_args[i]); + } + if( ASR::is_a(*array_constant_t->m_args[i]) ) { + T* aci = ASR::down_cast(array_constant_t->m_args[i]); for( size_t j = 0; j < aci->n_args; j++ ) { new_elements.push_back(al, aci->m_args[j]); } @@ -2220,10 +2245,16 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor(*array_constant) ) { + flatten_ArrayConstant(array_constant); + } else if( ASR::is_a(*array_constant) ) { + flatten_ArrayConstant(array_constant); + } else { + throw std::runtime_error("Only ArrayConstant and ArrayConstructor can be flattened."); + } tmp = (ASR::asr_t*) array_constant; return true; } @@ -2741,8 +2772,7 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitortype != right_type->type || lkind != rkind ) { - throw SemanticError("Casting for mismatching pointer types not supported yet.", - right_type->base.loc); + throw std::runtime_error("Casting for mismatching pointer types not supported yet."); } } @@ -2765,8 +2795,8 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitorbase.loc, dest_type, m_dims, n_dims); } - left = CastingUtil::perform_casting(left, left_type, dest_type_left, al, left->base.loc); - right = CastingUtil::perform_casting(right, right_type, dest_type_right, al, right->base.loc); + left = CastingUtil::perform_casting(left, dest_type_left, al, left->base.loc); + right = CastingUtil::perform_casting(right, dest_type_right, al, right->base.loc); return ; } @@ -2779,8 +2809,7 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitorbase.loc); + src_expr, dest_type, al, src_expr->base.loc); if( casted_expression_signal == 0 ) { left = src_expr; right = dest_expr; @@ -3070,7 +3099,7 @@ class ClangASTtoASRVisitor: public clang::RecursiveASTVisitor `symbol` mappings. +-- Documenations are available at: +-- https://github.com/lfortran/lfortran/tree/main/doc/src/asr/asr.md module ASR { unit = TranslationUnit(symbol_table symtab, node* items) --- # Documentation for the symbol type - --- Each symbol has either `symtab` (local symbol table) or `parent_symtab` --- (where this symbol is stored). One can get to parent_symtab via symtab, so --- only one is present. - --- Each symbol has a `name` for easy lookup of the name of the symbol when only --- having a pointer to it. - --- abi=Source means the symbol's implementation is included (full ASR), --- otherwise it is external (interface ASR, such as procedure interface). - --- SubroutineCall/FunctionCall store the actual final resolved subroutine or --- function (`name` member). They also store the original symbol --- (`original_name`), which can be one of: null, GenericProcedure or --- ExternalSymbol. - --- When a module is compiled, it is parsed into full ASR, an object file is --- produced, the full ASR (abi=Source, "body" is non-empty) is transformed into --- interface ASR (abi=LFortran, "body" is empty). Both interface and full ASR --- is saved into the mod file. - --- When a module is used, it is first looked up in the symbol table (as either --- full or interface ASR) and used if it is present. Otherwise a mod file is --- found on the disk, loaded (as either full or interface ASR for LFortran's --- mod file, depending on LFortran's compiler options; or for GFortran's mod --- file the corresponding interface ASR is constructed with abi=GFortran) and --- used. After the ASR is loaded, the symbols that are used are represented as --- ExternalSymbols in the current scope of the symbol table. - --- ExternalSymbol represents symbols that cannot be looked up in the current --- scoped symbol table. As an example, if a variable is defined in a module, --- but used in a nested subroutine, that is not an external symbol --- because it can be resolved in the current symbol table (nested subroutine) --- by following the parents. However if a symbol is used from a different --- module, then it is an external symbol, because usual symbol resolution by --- going to the parents will not find the definition. The `module_name` member --- is the name of the module the symbol is in, the `scope_names` is a list of --- names if the symbol is in a nested symbol table. For example if it is a --- local variable in a function `f` that is nested in function `g`, then --- `scope_names=[g, f]`. - --- REPL: each cell is parsed into full ASR, compiled + executed, the full ASR --- is transformed into interface ASR (abi=LFortran) and kept in the symbol --- table. A new cell starts with an empty symbol table, whose parent symbol --- table is the previous cell. That allows function / declaration shadowing. - - symbol - = Program(symbol_table symtab, identifier name, identifier* dependencies, - stmt* body) - | Module(symbol_table symtab, identifier name, identifier* dependencies, - bool loaded_from_mod, bool intrinsic) - | Function(symbol_table symtab, identifier name, ttype function_signature, - identifier* dependencies, expr* args, stmt* body, expr? return_var, - access access, bool deterministic, bool side_effect_free, string? module_file) - | GenericProcedure(symbol_table parent_symtab, identifier name, - symbol* procs, access access) - | CustomOperator(symbol_table parent_symtab, identifier name, - symbol* procs, access access) - | ExternalSymbol(symbol_table parent_symtab, identifier name, - symbol external, identifier module_name, identifier* scope_names, - identifier original_name, access access) - | StructType(symbol_table symtab, identifier name, identifier* dependencies, - identifier* members, abi abi, access access, bool is_packed, bool is_abstract, - call_arg* initializers, expr? alignment, symbol? parent) - | EnumType(symbol_table symtab, identifier name, identifier* dependencies, - identifier* members, abi abi, access access, enumtype enum_value_type, - ttype type, symbol? parent) - | UnionType(symbol_table symtab, identifier name, identifier* dependencies, - identifier* members, abi abi, access access, call_arg* initializers, symbol? parent) - | Variable(symbol_table parent_symtab, identifier name, identifier* dependencies, - intent intent, expr? symbolic_value, expr? value, storage_type storage, - ttype type, symbol? type_declaration, - abi abi, access access, presence presence, bool value_attr) + = Program(symbol_table symtab, identifier name, identifier* dependencies, stmt* body) + | Module(symbol_table symtab, identifier name, identifier* dependencies, bool loaded_from_mod, bool intrinsic) + | Function(symbol_table symtab, identifier name, ttype function_signature, identifier* dependencies, expr* args, stmt* body, expr? return_var, access access, bool deterministic, bool side_effect_free, string? module_file) + | GenericProcedure(symbol_table parent_symtab, identifier name, symbol* procs, access access) + | CustomOperator(symbol_table parent_symtab, identifier name, symbol* procs, access access) + | ExternalSymbol(symbol_table parent_symtab, identifier name, symbol external, identifier module_name, identifier* scope_names, identifier original_name, access access) + | StructType(symbol_table symtab, identifier name, identifier* dependencies, identifier* members, abi abi, access access, bool is_packed, bool is_abstract, call_arg* initializers, expr? alignment, symbol? parent) + | EnumType(symbol_table symtab, identifier name, identifier* dependencies, identifier* members, abi abi, access access, enumtype enum_value_type, ttype type, symbol? parent) + | UnionType(symbol_table symtab, identifier name, identifier* dependencies, identifier* members, abi abi, access access, call_arg* initializers, symbol? parent) + | Variable(symbol_table parent_symtab, identifier name, identifier* dependencies, intent intent, expr? symbolic_value, expr? value, storage_type storage, ttype type, symbol? type_declaration, abi abi, access access, presence presence, bool value_attr) | ClassType(symbol_table symtab, identifier name, abi abi, access access) - | ClassProcedure(symbol_table parent_symtab, identifier name, identifier? self_argument, - identifier proc_name, symbol proc, abi abi, bool is_deferred) + | ClassProcedure(symbol_table parent_symtab, identifier name, identifier? self_argument, identifier proc_name, symbol proc, abi abi, bool is_deferred, bool is_nopass) | AssociateBlock(symbol_table symtab, identifier name, stmt* body) | Block(symbol_table symtab, identifier name, stmt* body) - | Requirement(symbol_table symtab, identifier name, identifier* args, - require_instantiation* requires) - | Template(symbol_table symtab, identifier name, identifier* args, - require_instantiation* requires) - -storage_type = Default | Save | Parameter -access = Public | Private -intent = Local | In | Out | InOut | ReturnVar | Unspecified -deftype = Implementation | Interface -presence = Required | Optional - --- # Documentation for the ABI type - --- External Yes: the symbol's implementation is not part of ASR, the --- symbol is just an interface (e.g., subroutine/function interface, or variable --- marked as external, not allocated by this ASR). - --- External No: the symbol's implementation is part of ASR (e.g., --- subroutine/function body is included, variables must be allocated). - --- abi=Source: The symbol's implementation is included in ASR, the backend is --- free to use any ABI it wants (it might also decide to inline or eliminate --- the code in optimizations). - --- abi=LFortranModule/GFortranModule/BindC: the symbol's implementation is --- stored as machine code in some object file that must be linked in. It --- uses the specified ABI (one of LFortran module, GFortran module or C ABI). --- An interface that uses `iso_c_binding` and `bind(c)` is represented using --- abi=BindC. - --- abi=BindPython: the symbol's implementation is --- stored in text format in the user source code file. --- The symbol is executed using the CPython interpreter. --- LPython manages the conversion of arguments to be passed to such symbols --- and also converts the return values from such symbols. - --- abi=BindJS: the symbol's implementation is --- available with Javascript. --- This abi type is to be mainly used with the WASM Backend. - --- abi=Interactive: the symbol's implementation has been provided by the --- previous REPL execution (e.g., if LLVM backend is used for the interactive --- mode, the previous execution generated machine code for this symbol's --- implementation that was loaded into memory). Note: this option might be --- converted/eliminated to just use LFortran ABI in the future. - --- abi=Intrinsic: the symbol's implementation is implicitly provided by the --- language itself as an intrinsic function. That means the backend is free to --- implement it in any way it wants. The function does not have a body, it is --- just an interface. - -abi -- External ABI - = Source -- No Unspecified - | LFortranModule -- Yes LFortran - | GFortranModule -- Yes GFortran - | BindC -- Yes C - | BindPython -- Yes Python - | BindJS -- Yes Javascript - | Interactive -- Yes Unspecified - | Intrinsic -- Yes Unspecified - + | Requirement(symbol_table symtab, identifier name, identifier* args, require_instantiation* requires) + | Template(symbol_table symtab, identifier name, identifier* args, require_instantiation* requires) stmt = Allocate(alloc_arg* args, expr? stat, expr? errmsg, expr? source) @@ -180,46 +33,33 @@ stmt | Assignment(expr target, expr value, stmt? overloaded) | Associate(expr target, expr value) | Cycle(identifier? stmt_name) - -- deallocates if allocated otherwise throws a runtime error | ExplicitDeallocate(expr* vars) - -- deallocates if allocated otherwise does nothing | ImplicitDeallocate(expr* vars) | DoConcurrentLoop(do_loop_head head, stmt* body) - | DoLoop(identifier? name, do_loop_head head, stmt* body) + | DoLoop(identifier? name, do_loop_head head, stmt* body, stmt* orelse) | ErrorStop(expr? code) | Exit(identifier? stmt_name) | ForAllSingle(do_loop_head head, stmt assign_stmt) - -- GoTo points to a GoToTarget with the corresponding target_id within - -- the same procedure. We currently use `int` IDs to link GoTo with - -- GoToTarget to avoid issues with serialization. | GoTo(int target_id, identifier name) - -- An empty statement, a target of zero or more GoTo statements - -- the `id` is only unique within a procedure | GoToTarget(int id, identifier name) | If(expr test, stmt* body, stmt* orelse) | IfArithmetic(expr test, int lt_label, int eq_label, int gt_label) | Print(expr* values, expr? separator, expr? end) | FileOpen(int label, expr? newunit, expr? filename, expr? status, expr? form) | FileClose(int label, expr? unit, expr? iostat, expr? iomsg, expr? err, expr? status) - | FileRead(int label, expr? unit, expr? fmt, expr? iomsg, expr? iostat, expr? id, expr* values) + | FileRead(int label, expr? unit, expr? fmt, expr? iomsg, expr? iostat, expr? size, expr? id, expr* values, stmt? overloaded) | FileBackspace(int label, expr? unit, expr? iostat, expr? err) | FileRewind(int label, expr? unit, expr? iostat, expr? err) - | FileInquire(int label, expr? unit, expr? file, expr? iostat, expr? err, - expr? exist, expr? opened, expr? number, expr? named, - expr? name, expr? access, expr? sequential, expr? direct, - expr? form, expr? formatted, expr? unformatted, expr? recl, - expr? nextrec, expr? blank, expr? position, expr? action, - expr? read, expr? write, expr? readwrite, expr? delim, - expr? pad, expr? flen, expr? blocksize, expr? convert, - expr? carriagecontrol, expr? iolength) - | FileWrite(int label, expr? unit, expr? iomsg, expr? iostat, expr? id, expr* values, expr? separator, expr? end) + | FileInquire(int label, expr? unit, expr? file, expr? iostat, expr? err, expr? exist, expr? opened, expr? number, expr? named, expr? name, expr? access, expr? sequential, expr? direct, expr? form, expr? formatted, expr? unformatted, expr? recl, expr? nextrec, expr? blank, expr? position, expr? action, expr? read, expr? write, expr? readwrite, expr? delim, expr? pad, expr? flen, expr? blocksize, expr? convert, expr? carriagecontrol, expr? iolength) + | FileWrite(int label, expr? unit, expr? iomsg, expr? iostat, expr? id, expr* values, expr? separator, expr? end, stmt? overloaded) | Return() | Select(expr test, case_stmt* body, stmt* default, bool enable_fall_through) | Stop(expr? code) | Assert(expr test, expr? msg) | SubroutineCall(symbol name, symbol? original_name, call_arg* args, expr? dt) + | IntrinsicImpureSubroutine(int intrinsic_id, expr* args, int overload_id) | Where(expr test, stmt* body, stmt* orelse) - | WhileLoop(identifier? name, expr test, stmt* body) + | WhileLoop(identifier? name, expr test, stmt* body, stmt* orelse) | Nullify(symbol* vars) | Flush(int label, expr unit, expr? err, expr? iomsg, expr? iostat) | ListAppend(expr a, expr ele) @@ -229,32 +69,25 @@ stmt | BlockCall(int label, symbol m) | SetInsert(expr a, expr ele) | SetRemove(expr a, expr ele) - | ListReserve(expr a, expr size) | ListInsert(expr a, expr pos, expr ele) | ListRemove(expr a, expr ele) | ListClear(expr a) | DictInsert(expr a, expr key, expr value) | Expr(expr expression) - expr = IfExp(expr test, expr body, expr orelse, ttype type, expr? value) - -- Such as: (x, y+z), (3.0, 2.0) generally not known at compile time | ComplexConstructor(expr re, expr im, ttype type, expr? value) | NamedExpr(expr target, expr value, ttype type) - | FunctionCall(symbol name, symbol? original_name, call_arg* args, - ttype type, expr? value, expr? dt) - | IntrinsicScalarFunction(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) + | FunctionCall(symbol name, symbol? original_name, call_arg* args, ttype type, expr? value, expr? dt) + | IntrinsicElementalFunction(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) + | TypeInquiry(int inquiry_id, ttype arg_type, expr? arg, ttype type, expr value) | StructTypeConstructor(symbol dt_sym, call_arg* args, ttype type, expr? value) | EnumTypeConstructor(symbol dt_sym, expr* args, ttype type, expr? value) | UnionTypeConstructor(symbol dt_sym, expr* args, ttype type, expr? value) - | ImpliedDoLoop(expr* values, expr var, expr start, expr end, - expr? increment, ttype type, expr? value) + | ImpliedDoLoop(expr* values, expr var, expr start, expr end, expr? increment, ttype type, expr? value) | IntegerConstant(int n, ttype type) | IntegerBOZ(int v, integerboz intboz_type, ttype? type) | IntegerBitNot(expr arg, ttype type, expr? value) @@ -279,21 +112,17 @@ expr | LogicalNot(expr arg, ttype type, expr? value) | LogicalCompare(expr left, cmpop op, expr right, ttype type, expr? value) | LogicalBinOp(expr left, logicalbinop op, expr right, ttype type, expr? value) - | ListConstant(expr* args, ttype type) | ListLen(expr arg, ttype type, expr? value) | ListConcat(expr left, expr right, ttype type, expr? value) | ListCompare(expr left, cmpop op, expr right, ttype type, expr? value) | ListCount(expr arg, expr ele, ttype type, expr? value) - | SetConstant(expr* elements, ttype type) | SetLen(expr arg, ttype type, expr? value) - | TupleConstant(expr* elements, ttype type) | TupleLen(expr arg, ttype type, expr value) | TupleCompare(expr left, cmpop op, expr right, ttype type, expr? value) | TupleConcat(expr left, expr right, ttype type, expr? value) - | StringConstant(string s, ttype type) | StringConcat(expr left, expr right, ttype type, expr? value) | StringRepeat(expr left, expr right, ttype type, expr? value) @@ -304,28 +133,23 @@ expr | StringOrd(expr arg, ttype type, expr? value) | StringChr(expr arg, ttype type, expr? value) | StringFormat(expr fmt, expr* args, string_format_kind kind, ttype type, expr? value) - | CPtrCompare(expr left, cmpop op, expr right, ttype type, expr? value) | SymbolicCompare(expr left, cmpop op, expr right, ttype type, expr? value) - | DictConstant(expr* keys, expr* values, ttype type) | DictLen(expr arg, ttype type, expr? value) - | Var(symbol v) - | FunctionParam(int param_number, ttype type, expr? value) --- used in types - + | FunctionParam(int param_number, ttype type, expr? value) + | ArrayConstructor(expr* args, ttype type, expr? value, arraystorage storage_format) | ArrayConstant(expr* args, ttype type, arraystorage storage_format) | ArrayItem(expr v, array_index* args, ttype type, arraystorage storage_format, expr? value) | ArraySection(expr v, array_index* args, ttype type, expr? value) | ArraySize(expr v, expr? dim, ttype type, expr? value) - | ArrayBound(expr v, expr? dim, ttype type, arraybound bound, - expr? value) + | ArrayBound(expr v, expr? dim, ttype type, arraybound bound, expr? value) | ArrayTranspose(expr matrix, ttype type, expr? value) | ArrayPack(expr array, expr mask, expr? vector, ttype type, expr? value) | ArrayReshape(expr array, expr shape, ttype type, expr? value) | ArrayAll(expr mask, expr? dim, ttype type, expr? value) | ArrayBroadcast(expr array, expr shape, ttype type, expr? value) - | BitCast(expr source, expr mold, expr? size, ttype type, expr? value) | StructInstanceMember(expr v, symbol m, ttype type, expr? value) | StructStaticMember(expr v, symbol m, ttype type, expr? value) @@ -336,21 +160,8 @@ expr | OverloadedCompare(expr left, cmpop op, expr right, ttype type, expr? value, expr overloaded) | OverloadedBinOp(expr left, binop op, expr right, ttype type, expr? value, expr overloaded) | OverloadedUnaryMinus(expr arg, ttype type, expr? value, expr overloaded) - -- This Cast changes the value (the bits) of the `arg`: + | OverloadedStringConcat(expr left, expr right, ttype type, expr? value, expr overloaded) | Cast(expr arg, cast_kind kind, ttype type, expr? value) - -- This ArrayPhysicalCast we only change the physical type, the logical type does not change - -- Note: the "new" physical type here will also be part of the "type" member - -- This allow to represent any combination, but we'll only support a few, at least we need: - -- Maybe it's easier to add an enumeration here: - -- Descriptor -> Pointer - -- Pointer -> Descriptor - - -- CompileTimeFixedSizeArray -> Pointer - -- CompileTimeFixedSizeArray -> Descriptor - -- Descriptor -> NumPy - -- NumPy -> Descriptor - -- ISODescriptor -> Descriptor - -- Descriptor -> ISODescriptor | ArrayPhysicalCast(expr arg, array_physical_type old, array_physical_type new, ttype type, expr? value) | ComplexRe(expr arg, ttype type, expr? value) | ComplexIm(expr arg, ttype type, expr? value) @@ -367,33 +178,10 @@ expr | IntegerBitLen(expr a, ttype type, expr? value) | Ichar(expr arg, ttype type, expr? value) | Iachar(expr arg, ttype type, expr? value) - | SizeOfType(ttype arg, ttype type, expr? value) - | PointerNullConstant(ttype type) | PointerAssociated(expr ptr, expr? tgt, ttype type, expr? value) - - | IntrinsicFunctionSqrt(expr arg, ttype type, expr? value) - - --- `len` in Character: --- >=0 ... the length of the string, known at compile time --- -1 ... character(*), i.e., inferred at runtime --- -2 ... character(:), allocatable (possibly we might use -1 for that also) --- -3 ... character(n+3), i.e., a runtime expression stored in `len_expr` - --- kind: The `kind` member selects the kind of a given type. We currently --- support the following: --- Integer kinds: 1 (i8), 2 (i16), 4 (i32), 8 (i64) --- Real kinds: 4 (f32), 8 (f64) --- Complex kinds: 4 (c32), 8 (c64) --- Character kinds: 1 (utf8 string) --- Logical kinds: 1, 2, 4: (boolean represented by 1, 2, 4 bytes; the default --- kind is 4, just like the default integer kind, consistent with Python --- and Fortran: in Python "Booleans in Python are implemented as a subclass --- of integers", in Fortran the "default logical kind has the same storage --- size as the default integer"; we currently use kind=4 as default --- integer, so we also use kind=4 for the default logical.) + | RealSqrt(expr arg, ttype type, expr? value) ttype = Integer(int kind) @@ -417,98 +205,34 @@ ttype | SymbolicExpression() | TypeParameter(identifier param) | Array(ttype type, dimension* dims, array_physical_type physical_type) - | FunctionType(ttype* arg_types, ttype? return_var_type, - abi abi, deftype deftype, string? bindc_name, bool elemental, - bool pure, bool module, bool inline, bool static, - symbol* restrictions, bool is_restriction) - --- TODO: prefix the enumerators here, improve the names -array_physical_type - = DescriptorArray - | PointerToDataArray - | UnboundedPointerToDataArray - | FixedSizeArray - | NumPyArray - | ISODescriptorArray - | SIMDArray - -binop = Add | Sub | Mul | Div | Pow | BitAnd | BitOr | BitXor | BitLShift | BitRShift - -logicalbinop = And | Or | Xor | NEqv | Eqv - -cmpop = Eq | NotEq | Lt | LtE | Gt | GtE - -integerboz = Binary | Hex | Octal - -arraybound = LBound | UBound - -arraystorage = RowMajor | ColMajor - -cast_kind - = RealToInteger - | IntegerToReal - | LogicalToReal - | RealToReal - | IntegerToInteger - | RealToComplex - | IntegerToComplex - | IntegerToLogical - | RealToLogical - | CharacterToLogical - | CharacterToInteger - | CharacterToList - | ComplexToLogical - | ComplexToComplex - | ComplexToReal - | ComplexToInteger - | LogicalToInteger - | RealToCharacter - | IntegerToCharacter - | LogicalToCharacter - | UnsignedIntegerToInteger - | UnsignedIntegerToUnsignedInteger - | UnsignedIntegerToReal - | UnsignedIntegerToLogical - | IntegerToUnsignedInteger - | RealToUnsignedInteger - | CPtrToUnsignedInteger - | UnsignedIntegerToCPtr - | IntegerToSymbolicExpression - | ListToArray + | FunctionType(ttype* arg_types, ttype? return_var_type, abi abi, deftype deftype, string? bindc_name, bool elemental, bool pure, bool module, bool inline, bool static, symbol* restrictions, bool is_restriction) +cast_kind = RealToInteger | IntegerToReal | LogicalToReal | RealToReal | IntegerToInteger | RealToComplex | IntegerToComplex | IntegerToLogical | RealToLogical | CharacterToLogical | CharacterToInteger | CharacterToList | ComplexToLogical | ComplexToComplex | ComplexToReal | ComplexToInteger | LogicalToInteger | RealToCharacter | IntegerToCharacter | LogicalToCharacter | UnsignedIntegerToInteger | UnsignedIntegerToUnsignedInteger | UnsignedIntegerToReal | UnsignedIntegerToLogical | IntegerToUnsignedInteger | RealToUnsignedInteger | CPtrToUnsignedInteger | UnsignedIntegerToCPtr | IntegerToSymbolicExpression | ListToArray +storage_type = Default | Save | Parameter +access = Public | Private +intent = Local | In | Out | InOut | ReturnVar | Unspecified +deftype = Implementation | Interface +presence = Required | Optional +abi = Source | LFortranModule | GFortranModule | BindC | BindPython | BindJS | Interactive | Intrinsic dimension = (expr? start, expr? length) - alloc_arg = (expr a, dimension* dims, expr? len_expr, ttype? type) - attribute = Attribute(identifier name, attribute_arg *args) - attribute_arg = (identifier arg) - call_arg = (expr? value) - tbind = Bind(string lang, string name) - array_index = (expr? left, expr? right, expr? step) - do_loop_head = (expr? v, expr? start, expr? end, expr? increment) - -case_stmt = CaseStmt(expr* test, stmt* body, bool fall_through) | - CaseStmt_Range(expr? start, expr? end, stmt* body) - -type_stmt - = TypeStmtName(symbol sym, stmt* body) - | ClassStmt(symbol sym, stmt* body) - | TypeStmtType(ttype type, stmt* body) - +case_stmt = CaseStmt(expr* test, stmt* body, bool fall_through) | CaseStmt_Range(expr? start, expr? end, stmt* body) +type_stmt = TypeStmtName(symbol sym, stmt* body) | ClassStmt(symbol sym, stmt* body) | TypeStmtType(ttype type, stmt* body) enumtype = IntegerConsecutiveFromZero | IntegerUnique | IntegerNotUnique | NonInteger - require_instantiation = Require(identifier name, identifier* args) - -string_format_kind - = FormatFortran -- "(f8.3,i4.2)", a, b - | FormatC -- "%f: %d", a, b - | FormatPythonPercent -- "%f: %d" % (a, b) - | FormatPythonFString -- f"{a}: {b}" - | FormatPythonFormat -- "{}: {}".format(a, b) +array_physical_type = DescriptorArray | PointerToDataArray | UnboundedPointerToDataArray | FixedSizeArray | CharacterArraySinglePointer | NumPyArray | ISODescriptorArray | SIMDArray +binop = Add | Sub | Mul | Div | Pow | BitAnd | BitOr | BitXor | BitLShift | BitRShift +logicalbinop = And | Or | Xor | NEqv | Eqv +cmpop = Eq | NotEq | Lt | LtE | Gt | GtE +integerboz = Binary | Hex | Octal +arraybound = LBound | UBound +arraystorage = RowMajor | ColMajor +string_format_kind = FormatFortran | FormatC | FormatPythonPercent | FormatPythonFString | FormatPythonFormat } diff --git a/src/libasr/CMakeLists.txt b/src/libasr/CMakeLists.txt index af8fdba..a772a3b 100644 --- a/src/libasr/CMakeLists.txt +++ b/src/libasr/CMakeLists.txt @@ -18,6 +18,7 @@ set(SRC codegen/asr_to_cpp.cpp codegen/asr_to_c.cpp codegen/asr_to_julia.cpp + codegen/asr_to_python.cpp codegen/asr_to_fortran.cpp codegen/asr_to_py.cpp codegen/x86_assembler.cpp @@ -30,9 +31,11 @@ set(SRC pass/nested_vars.cpp pass/where.cpp + pass/function_call_in_declaration.cpp pass/param_to_const.cpp pass/do_loops.cpp pass/for_all.cpp + pass/while_else.cpp pass/global_stmts.cpp pass/select_case.cpp pass/init_expr.cpp @@ -51,6 +54,7 @@ set(SRC pass/div_to_mul.cpp pass/replace_symbolic.cpp pass/intrinsic_function.cpp + pass/intrinsic_subroutine.cpp pass/fma.cpp pass/loop_vectorise.cpp pass/sign_from_value.cpp @@ -64,6 +68,7 @@ set(SRC pass/pass_compare.cpp pass/unique_symbols.cpp pass/insert_deallocate.cpp + pass/promote_allocatable_to_nonallocatable.cpp asr_verify.cpp asr_utils.cpp @@ -111,3 +116,10 @@ endif() if (WITH_LLVM) target_link_libraries(asr p::llvm) endif() + +# Install the dwarf_convert.py and dat_convert.py +install( + FILES dwarf_convert.py dat_convert.py + PERMISSIONS OWNER_EXECUTE OWNER_READ + DESTINATION ${CMAKE_INSTALL_PREFIX}/share/lfortran +) diff --git a/src/libasr/asdl_cpp.py b/src/libasr/asdl_cpp.py index 06b0647..9463cb9 100644 --- a/src/libasr/asdl_cpp.py +++ b/src/libasr/asdl_cpp.py @@ -450,7 +450,7 @@ def make_visitor(self, name, fields): symtab_field_name = field.name if is_stmt_present and is_symtab_present: break - if is_stmt_present and name not in ("Assignment", "ForAllSingle"): + if is_stmt_present and name not in ("Assignment", "ForAllSingle", "FileRead", "FileWrite"): self.emit(" %s_t& xx = const_cast<%s_t&>(x);" % (name, name), 1) self.used = False @@ -562,7 +562,7 @@ def make_visitor(self, name, fields): symtab_field_name = field.name if is_stmt_present and is_symtab_present: break - if is_stmt_present and name not in ("Assignment", "ForAllSingle"): + if is_stmt_present and name not in ("Assignment", "ForAllSingle", "FileRead", "FileWrite"): self.emit(" %s_t& xx = const_cast<%s_t&>(x);" % (name, name), 1) self.used = False @@ -1029,17 +1029,13 @@ def visitConstructor(self, cons, _): def make_visitor(self, name, fields): self.emit("") self.emit("ASR::asr_t* duplicate_%s(%s_t* x) {" % (name, name), 1) - self.used = False - arguments = [] + arguments = ["al", "x->base.base.loc"] for field in fields: ret_value = self.visitField(field) for node_arg in ret_value: arguments.append(node_arg) - if not self.used: - self.emit("return (asr_t*)x;", 2) - else: - node_arg_str = ', '.join(arguments) - self.emit("return make_%s_t(al, x->base.base.loc, %s);" %(name, node_arg_str), 2) + node_arg_str = ', '.join(arguments) + self.emit("return make_%s_t(%s);" %(name, node_arg_str), 2) if self.is_stmt: self.duplicate_stmt.append((" case ASR::stmtType::%s: {" % name, 2)) if name == "SubroutineCall": @@ -1088,7 +1084,6 @@ def visitField(self, field): field.type == "dimension"): level = 2 if field.seq: - self.used = True pointer_char = '' if (field.type != "call_arg" and field.type != "array_index" and @@ -1141,7 +1136,6 @@ def visitField(self, field): self.emit("}", level) arguments = ("m_" + field.name + ".p", "x->n_" + field.name) else: - self.used = True if field.type == "symbol": self.emit("%s_t* m_%s = x->m_%s;" % (field.type, field.name, field.name), level) elif field.type == "do_loop_head": @@ -1461,12 +1455,6 @@ def visitConstructor(self, cons, _): def make_visitor(self, name, fields, cons): self.emit("void visit_%s(const %s_t &x) {" % (name, name), 1) self.emit( 's.append("(");', 2) - subs = { - "Assignment": "=", - "Associate": "=>", - } - if name in subs: - name = subs[name] # For ASR symbol = [ @@ -1680,7 +1668,7 @@ def visitField(self, field, cons): self.emit( 's.append("()");', 3) self.emit("}", 2) else: - if field.name == "intrinsic_id": + if field.name == "intrinsic_id" or field.name == "inquiry_id": 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) @@ -2593,7 +2581,8 @@ def make_visitor(self, name, fields): LCOMPILERS_ASSERT(!ASR::is_a(*e->m_external)); s = e->m_external; } - if( ASR::down_cast(s)->m_storage != + if( ASR::is_a(*s) || + ASR::down_cast(s)->m_storage != ASR::storage_typeType::Parameter ) { return nullptr; } diff --git a/src/libasr/asr_builder.h b/src/libasr/asr_builder.h new file mode 100644 index 0000000..0e40733 --- /dev/null +++ b/src/libasr/asr_builder.h @@ -0,0 +1,1047 @@ +#ifndef LIBASR_BUILDER_H +#define LIBASR_BUILDER_H + +#include +#include +#include +#include + +namespace LCompilers::ASRUtils { + +class ASRBuilder { + private: + + Allocator& al; + // TODO: use the location to point C++ code in `intrinsic_function_registry` + const Location &loc; + + public: + + ASRBuilder(Allocator& al_, const Location& loc_): al(al_), loc(loc_) {} + + #define make_ConstantWithKind(Constructor, TypeConstructor, value, kind, loc) ASRUtils::EXPR( \ + ASR::Constructor( al, loc, value, \ + ASRUtils::TYPE(ASR::TypeConstructor(al, loc, kind)))) \ + + #define make_ConstantWithType(Constructor, value, type, loc) ASRUtils::EXPR( \ + ASR::Constructor(al, loc, value, type)) \ + + #define declare_basic_variables(name) \ + std::string fn_name = scope->get_unique_name(name, false); \ + SymbolTable *fn_symtab = al.make_new(scope); \ + ASRBuilder b(al, loc); \ + Vec args; args.reserve(al, 1); \ + Vec body; body.reserve(al, 1); \ + SetChar dep; dep.reserve(al, 1); + + // Symbols ----------------------------------------------------------------- + ASR::expr_t *Variable(SymbolTable *symtab, std::string var_name, + ASR::ttype_t *type, ASR::intentType intent, + ASR::abiType abi=ASR::abiType::Source, bool a_value_attr=false) { + ASR::symbol_t* sym = ASR::down_cast( + ASR::make_Variable_t(al, loc, symtab, s2c(al, var_name), nullptr, 0, + intent, nullptr, nullptr, ASR::storage_typeType::Default, type, nullptr, abi, + ASR::Public, ASR::presenceType::Required, a_value_attr)); + symtab->add_symbol(s2c(al, var_name), sym); + return ASRUtils::EXPR(ASR::make_Var_t(al, loc, sym)); + } + + #define declare(var_name, type, intent) \ + b.Variable(fn_symtab, var_name, type, ASR::intentType::intent) + + #define fill_func_arg(arg_name, type) { \ + auto arg = declare(arg_name, type, In); \ + args.push_back(al, arg); } + + #define fill_func_arg_sub(arg_name, type, intent) { \ + auto arg = declare(arg_name, type, intent); \ + args.push_back(al, arg); } + + #define make_ASR_Function_t(name, symtab, dep, args, body, return_var, abi, \ + deftype, bindc_name) \ + ASR::down_cast( ASRUtils::make_Function_t_util(al, loc, \ + symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, \ + return_var, abi, ASR::accessType::Public, \ + deftype, bindc_name, false, false, false, false, \ + false, nullptr, 0, false, false, false)); + + #define make_Function_Without_ReturnVar_t(name, symtab, dep, args, body, \ + abi, deftype, bindc_name) \ + ASR::down_cast( ASRUtils::make_Function_t_util(al, loc, \ + symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, \ + nullptr, abi, ASR::accessType::Public, \ + deftype, bindc_name, false, false, false, false, \ + false, nullptr, 0, false, false, false)); + + // Types ------------------------------------------------------------------- + #define int8 TYPE(ASR::make_Integer_t(al, loc, 1)) + #define int16 TYPE(ASR::make_Integer_t(al, loc, 2)) + #define int32 TYPE(ASR::make_Integer_t(al, loc, 4)) + #define int64 TYPE(ASR::make_Integer_t(al, loc, 8)) + #define real32 TYPE(ASR::make_Real_t(al, loc, 4)) + #define real64 TYPE(ASR::make_Real_t(al, loc, 8)) + #define complex32 TYPE(ASR::make_Complex_t(al, loc, 4)) + #define logical TYPE(ASR::make_Logical_t(al, loc, 4)) + #define character(x) TYPE(ASR::make_Character_t(al, loc, 1, x, nullptr)) + #define List(x) TYPE(ASR::make_List_t(al, loc, x)) + + ASR::ttype_t *Tuple(std::vector tuple_type) { + Vec m_tuple_type; m_tuple_type.reserve(al, 3); + for (auto &x: tuple_type) { + m_tuple_type.push_back(al, x); + } + return TYPE(ASR::make_Tuple_t(al, loc, m_tuple_type.p, m_tuple_type.n)); + } + ASR::ttype_t *Array(std::vector dims, ASR::ttype_t *type) { + Vec m_dims; m_dims.reserve(al, 1); + for (auto &x: dims) { + ASR::dimension_t dim; + dim.loc = loc; + if (x == -1) { + dim.m_start = nullptr; + dim.m_length = nullptr; + } else { + dim.m_start = EXPR(ASR::make_IntegerConstant_t(al, loc, 1, int32)); + dim.m_length = EXPR(ASR::make_IntegerConstant_t(al, loc, x, int32)); + } + m_dims.push_back(al, dim); + } + return make_Array_t_util(al, loc, type, m_dims.p, m_dims.n); + } + + // Expressions ------------------------------------------------------------- + inline ASR::expr_t* i(int64_t x, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerConstant_t(al, loc, x, t)); + } + + inline ASR::expr_t* i32(int64_t x) { + return EXPR(ASR::make_IntegerConstant_t(al, loc, x, int32)); + } + + inline ASR::expr_t* i64(int64_t x) { + return EXPR(ASR::make_IntegerConstant_t(al, loc, x, int64)); + } + + inline ASR::expr_t* i32_n(int64_t x) { + return EXPR(ASR::make_IntegerUnaryMinus_t(al, loc, i32(abs(x)), int32, i32(x))); + } + + inline ASR::expr_t* i32_neg(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerUnaryMinus_t(al, loc, x, t, nullptr)); + } + + inline ASR::expr_t* f(double x, ASR::ttype_t* t) { + return EXPR(ASR::make_RealConstant_t(al, loc, x, t)); + } + + inline ASR::expr_t* f32(double x) { + return EXPR(ASR::make_RealConstant_t(al, loc, x, real32)); + } + + inline ASR::expr_t* f32_neg(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_RealUnaryMinus_t(al, loc, x, t, nullptr)); + } + + inline ASR::expr_t* bool32(bool x) { + return EXPR(ASR::make_LogicalConstant_t(al, loc, x, logical)); + } + + inline ASR::expr_t* bool_t(bool x, ASR::ttype_t* t) { + return EXPR(ASR::make_LogicalConstant_t(al, loc, x, t)); + } + + inline ASR::expr_t* complex(double x, double y, ASR::ttype_t* t) { + return EXPR(ASR::make_ComplexConstant_t(al, loc, x, y, t)); + } + + inline ASR::expr_t* c32(double x, double y) { + return EXPR(ASR::make_ComplexConstant_t(al, loc, x, y, complex32)); + } + + inline ASR::expr_t* ListItem(ASR::expr_t* x, ASR::expr_t* pos, ASR::ttype_t* type) { + return EXPR(ASR::make_ListItem_t(al, loc, x, pos, type, nullptr)); + } + + inline ASR::stmt_t* ListAppend(ASR::expr_t* x, ASR::expr_t* val) { + return STMT(ASR::make_ListAppend_t(al, loc, x, val)); + } + + inline ASR::expr_t* StringSection(ASR::expr_t* s, ASR::expr_t* start, ASR::expr_t* end) { + return EXPR(ASR::make_StringSection_t(al, loc, s, start, end, i32(1), character(-2), nullptr)); + } + + inline ASR::expr_t* StringItem(ASR::expr_t* x, ASR::expr_t* idx) { + return EXPR(ASR::make_StringItem_t(al, loc, x, idx, character(-2), nullptr)); + } + + inline ASR::expr_t* StringConstant(std::string s, ASR::ttype_t* type) { + return EXPR(ASR::make_StringConstant_t(al, loc, s2c(al, s), type)); + } + + inline ASR::expr_t* StringLen(ASR::expr_t* s) { + return EXPR(ASR::make_StringLen_t(al, loc, s, int32, nullptr)); + } + + inline ASR::expr_t* StringConcat(ASR::expr_t* s1, ASR::expr_t* s2, ASR::ttype_t* type) { + return EXPR(ASR::make_StringConcat_t(al, loc, s1, s2, type, nullptr)); + } + + inline ASR::expr_t* ArraySize(ASR::expr_t* x, ASR::expr_t* dim, ASR::ttype_t* t) { + return EXPR(ASR::make_ArraySize_t(al, loc, x, dim, t, nullptr)); + } + + inline ASR::expr_t* Ichar(std::string s, ASR::ttype_t* type, ASR::ttype_t* t) { + return EXPR(ASR::make_Ichar_t(al, loc, + EXPR(ASR::make_StringConstant_t(al, loc, s2c(al, s), type)), t, nullptr)); + } + + // Cast -------------------------------------------------------------------- + + inline ASR::expr_t* r2i8(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToInteger, int8, nullptr)); + } + + inline ASR::expr_t* r2i16(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToInteger, int16, nullptr)); + } + + inline ASR::expr_t* r2i32(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToInteger, int32, nullptr)); + } + + inline ASR::expr_t* r2i64(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToInteger, int64, nullptr)); + } + + inline ASR::expr_t* i2r32(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::IntegerToReal, real32, nullptr)); + } + + inline ASR::expr_t* i2r64(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::IntegerToReal, real64, nullptr)); + } + + inline ASR::expr_t* i2i(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::IntegerToInteger, t, nullptr)); + } + + inline ASR::expr_t* i2i64(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::IntegerToInteger, int64, nullptr)); + } + + inline ASR::expr_t* i2i32(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::IntegerToInteger, int32, nullptr)); + } + + inline ASR::expr_t* r2r32(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToReal, real32, nullptr)); + } + + inline ASR::expr_t* r2r64(ASR::expr_t* x) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToReal, real64, nullptr)); + } + + inline ASR::expr_t* r2r(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToReal, t, nullptr)); + } + + inline ASR::expr_t* r2i(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::RealToInteger, t, nullptr)); + } + + inline ASR::expr_t* i2r(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_Cast_t(al, loc, x, ASR::cast_kindType::IntegerToReal, t, nullptr)); + } + + // Binop ------------------------------------------------------------------- + + inline ASR::expr_t* iAdd(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Add, right, ASRUtils::int32, nullptr)); + } + + inline ASR::expr_t* i8Add(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Add, right, ASRUtils::int8, nullptr)); + } + + inline ASR::expr_t* i16Add(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Add, right, ASRUtils::int16, nullptr)); + } + + inline ASR::expr_t* i64Add(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Add, right, ASRUtils::int64, nullptr)); + } + + inline ASR::expr_t* rAdd(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Add, right, t, nullptr)); + } + + inline ASR::expr_t* r32Add(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Add, right, ASRUtils::real32, nullptr)); + } + + inline ASR::expr_t* r64Add(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Add, right, ASRUtils::real64, nullptr)); + } + + inline ASR::expr_t* i_tAdd(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Add, right, t, nullptr)); + } + + inline ASR::expr_t* r_tAdd(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Add, right, t, nullptr)); + } + + inline ASR::expr_t* iSub(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Sub, right, ASRUtils::int32, nullptr)); + } + + inline ASR::expr_t* i_vSub(ASR::expr_t* left, ASR::expr_t* right, ASR::expr_t* value) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Sub, right, ASRUtils::int32, value)); + } + + inline ASR::expr_t* i8Sub(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Sub, right, int8, nullptr)); + } + + inline ASR::expr_t* i16Sub(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Sub, right, int16, nullptr)); + } + + inline ASR::expr_t* i64Sub(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Sub, right, int64, nullptr)); + } + + inline ASR::expr_t* rSub(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Sub, right, t, nullptr)); + } + + inline ASR::expr_t* r32Sub(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Sub, right, ASRUtils::real32, nullptr)); + } + + inline ASR::expr_t* r64Sub(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Sub, right, ASRUtils::real64, nullptr)); + } + + inline ASR::expr_t* i_tSub(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Sub, right, t, nullptr)); + } + + inline ASR::expr_t* r_tSub(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Sub, right, t, nullptr)); + } + + inline ASR::expr_t* iDiv(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Div, right, ASRUtils::int32, nullptr)); + } + + inline ASR::expr_t* i8Div(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Div, right, ASRUtils::int8, nullptr)); + } + + inline ASR::expr_t* i16Div(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Div, right, ASRUtils::int16, nullptr)); + } + + inline ASR::expr_t* i64Div(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Div, right, ASRUtils::int64, nullptr)); + } + + inline ASR::expr_t* rDiv(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Div, right, t, nullptr)); + } + + inline ASR::expr_t* r32Div(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Div, right, ASRUtils::real32, nullptr)); + } + + inline ASR::expr_t* r64Div(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Div, right, ASRUtils::real64, nullptr)); + } + + inline ASR::expr_t* i_tDiv(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Div, right, t, nullptr)); + } + + inline ASR::expr_t* iMul(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Mul, right, ASRUtils::int32, nullptr)); + } + + inline ASR::expr_t* i8Mul(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Mul, right, ASRUtils::int8, nullptr)); + } + + inline ASR::expr_t* i16Mul(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Mul, right, ASRUtils::int16, nullptr)); + } + + inline ASR::expr_t* i64Mul(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Mul, right, ASRUtils::int64, nullptr)); + } + + inline ASR::expr_t* rMul(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Mul, right, t, nullptr)); + } + + inline ASR::expr_t* r32Mul(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Mul, right, ASRUtils::real32, nullptr)); + } + + inline ASR::expr_t* r64Mul(ASR::expr_t* left, ASR::expr_t* right) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Mul, right, ASRUtils::real64, nullptr)); + } + + inline ASR::expr_t* i_tMul(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Mul, right, t, nullptr)); + } + + inline ASR::expr_t* i_tAnd(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::BitAnd, right, t, nullptr)); + } + + inline ASR::expr_t* r_tMul(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Mul, right, t, nullptr)); + } + + inline ASR::expr_t* iPow(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, ASR::binopType::Pow, right, t, nullptr)); + } + + inline ASR::expr_t* rPow(ASR::expr_t* left, ASR::expr_t* right, ASR::ttype_t* t) { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, ASR::binopType::Pow, right, t, nullptr)); + } + + inline ASR::expr_t* And(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_LogicalBinOp_t(al, loc, x, ASR::logicalbinopType::And, y, logical, nullptr)); + } + + inline ASR::expr_t* Or(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_LogicalBinOp_t(al, loc, x, ASR::logicalbinopType::Or, y, logical, nullptr)); + } + + inline ASR::expr_t* Not(ASR::expr_t* x) { + return EXPR(ASR::make_LogicalNot_t(al, loc, x, logical, nullptr)); + } + + inline ASR::expr_t* i_BitRshift(ASR::expr_t* n, ASR::expr_t* bits, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, n, ASR::binopType::BitRShift, bits, t, nullptr)); + } + + inline ASR::expr_t* i_BitLshift(ASR::expr_t* n, ASR::expr_t* bits, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, n, ASR::binopType::BitLShift, bits, t, nullptr)); + } + + inline ASR::expr_t* i_BitNot(ASR::expr_t* x, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBitNot_t(al, loc, x, t, nullptr)); + } + + inline ASR::expr_t* i_BitAnd(ASR::expr_t* i, ASR::expr_t* j, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, i, ASR::binopType::BitAnd, j, t, nullptr)); + } + + inline ASR::expr_t* i_BitOr(ASR::expr_t* i, ASR::expr_t* j, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, i, ASR::binopType::BitOr, j, t, nullptr)); + } + + inline ASR::expr_t* i_BitXor(ASR::expr_t* i, ASR::expr_t* j, ASR::ttype_t* t) { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, i, ASR::binopType::BitXor, j, t, nullptr)); + } + + inline ASR::expr_t* sConstant(std::string s, ASR::ttype_t* type) { + return EXPR(ASR::make_StringConstant_t(al, loc, s2c(al, s), type)); + } + + ASR::expr_t *Add(ASR::expr_t *left, ASR::expr_t *right) { + LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); + ASR::ttype_t *type = expr_type(left); + ASRUtils::make_ArrayBroadcast_t_util(al, loc, left, right); + switch (type->type) { + case ASR::ttypeType::Integer : { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, + ASR::binopType::Add, right, type, nullptr)); + break; + } + case ASR::ttypeType::Real : { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, + ASR::binopType::Add, right, type, nullptr)); + break; + } + case ASR::ttypeType::Character : { + return EXPR(ASR::make_StringConcat_t(al, loc, left, + right, type, nullptr)); + break; + } + case ASR::ttypeType::Complex : { + return EXPR(ASR::make_ComplexBinOp_t(al, loc, left, + ASR::binopType::Add, right, type, nullptr)); + } + default: { + LCOMPILERS_ASSERT(false); + return nullptr; + } + } + } + + ASR::expr_t *Mul(ASR::expr_t *left, ASR::expr_t *right) { + LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); + ASR::ttype_t *type = expr_type(left); + ASRUtils::make_ArrayBroadcast_t_util(al, loc, left, right); + switch (type->type) { + case ASR::ttypeType::Integer : { + return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, + ASR::binopType::Mul, right, type, nullptr)); + break; + } + case ASR::ttypeType::Real : { + return EXPR(ASR::make_RealBinOp_t(al, loc, left, + ASR::binopType::Mul, right, type, nullptr)); + break; + } + case ASR::ttypeType::Complex : { + return EXPR(ASR::make_ComplexBinOp_t(al, loc, left, + ASR::binopType::Mul, right, type, nullptr)); + } + default: { + LCOMPILERS_ASSERT(false); + return nullptr; + } + } + } + + ASR::stmt_t* CallIntrinsicSubroutine(SymbolTable* scope, std::vector types, + std::vector args, int64_t overload_id, + ASR::stmt_t* (*intrinsic_subroutine)(Allocator &, const Location &, SymbolTable *, + Vec&, Vec&, int64_t)) { + Vec arg_types; arg_types.reserve(al, types.size()); + for (auto &x: types) arg_types.push_back(al, x); + + Vec new_args; new_args.reserve(al, args.size()); + for (auto &x: args) { + ASR::call_arg_t call_arg; call_arg.loc = loc; call_arg.m_value = x; + new_args.push_back(al, call_arg); + } + + return intrinsic_subroutine(al, loc, scope, arg_types, new_args, overload_id); + } + + ASR::expr_t* CallIntrinsic(SymbolTable* scope, std::vector types, + std::vector args, ASR::ttype_t* return_type, int64_t overload_id, + ASR::expr_t* (*intrinsic_func)(Allocator &, const Location &, SymbolTable *, + Vec&, ASR::ttype_t *, Vec&, int64_t)) { + Vec arg_types; arg_types.reserve(al, types.size()); + for (auto &x: types) arg_types.push_back(al, x); + + Vec new_args; new_args.reserve(al, args.size()); + for (auto &x: args) { + ASR::call_arg_t call_arg; call_arg.loc = loc; call_arg.m_value = x; + new_args.push_back(al, call_arg); + } + + return intrinsic_func(al, loc, scope, arg_types, return_type, new_args, overload_id); + } + + // Compare ----------------------------------------------------------------- + inline ASR::expr_t* iEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_IntegerCompare_t(al, loc, x, ASR::cmpopType::Eq, y, logical, nullptr)); + } + inline ASR::expr_t* iNotEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_IntegerCompare_t(al, loc, x, ASR::cmpopType::NotEq, y, logical, nullptr)); + } + inline ASR::expr_t* iLt(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_IntegerCompare_t(al, loc, x, ASR::cmpopType::Lt, y, logical, nullptr)); + } + inline ASR::expr_t* iLtE(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_IntegerCompare_t(al, loc, x, ASR::cmpopType::LtE, y, logical, nullptr)); + } + inline ASR::expr_t* iGtE(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_IntegerCompare_t(al, loc, x, ASR::cmpopType::GtE, y, logical, nullptr)); + } + inline ASR::expr_t* iGt(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_IntegerCompare_t(al, loc, x, ASR::cmpopType::Gt, y, logical, nullptr)); + } + inline ASR::expr_t* ArraySize_1(ASR::expr_t* x, ASR::expr_t* dim) { + return EXPR(make_ArraySize_t_util(al, loc, x, dim, int32, nullptr)); + } + inline ASR::expr_t* ArraySize_2(ASR::expr_t* x, ASR::expr_t* dim, ASR::ttype_t* t) { + return EXPR(make_ArraySize_t_util(al, loc, x, dim, t, nullptr)); + } + inline ASR::expr_t* fEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_RealCompare_t(al, loc, x, ASR::cmpopType::Eq, y, logical, nullptr)); + } + inline ASR::expr_t* fGtE(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_RealCompare_t(al, loc, x, ASR::cmpopType::GtE, y, logical, nullptr)); + } + inline ASR::expr_t* fLtE(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_RealCompare_t(al, loc, x, ASR::cmpopType::LtE, y, logical, nullptr)); + } + inline ASR::expr_t* fLt(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_RealCompare_t(al, loc, x, ASR::cmpopType::Lt, y, logical, nullptr)); + } + inline ASR::expr_t* fGt(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_RealCompare_t(al, loc, x, ASR::cmpopType::Gt, y, logical, nullptr)); + } + inline ASR::expr_t* fNotEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_RealCompare_t(al, loc, x, ASR::cmpopType::NotEq, y, logical, nullptr)); + } + inline ASR::expr_t* boolEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_LogicalCompare_t(al, loc, x, ASR::cmpopType::Eq, y, logical, nullptr)); + } + inline ASR::expr_t* sEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_StringCompare_t(al, loc, x, ASR::cmpopType::Eq, y, logical, nullptr)); + } + inline ASR::expr_t* sNotEq(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_StringCompare_t(al, loc, x, ASR::cmpopType::NotEq, y, logical, nullptr)); + } + inline ASR::expr_t* sLt(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_StringCompare_t(al, loc, x, ASR::cmpopType::Lt, y, logical, nullptr)); + } + inline ASR::expr_t* sLtE(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_StringCompare_t(al, loc, x, ASR::cmpopType::LtE, y, logical, nullptr)); + } + inline ASR::expr_t* sGt(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_StringCompare_t(al, loc, x, ASR::cmpopType::Gt, y, logical, nullptr)); + } + inline ASR::expr_t* sGtE(ASR::expr_t* x, ASR::expr_t* y) { + return EXPR(ASR::make_StringCompare_t(al, loc, x, ASR::cmpopType::GtE, y, logical, nullptr)); + } + + ASR::expr_t *Gt(ASR::expr_t *left, ASR::expr_t *right) { + LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); + if (is_real(*expr_type(left))) { + return fGt(left, right); + } else if (is_integer(*expr_type(left))) { + return iGt(left, right); + } else { + LCOMPILERS_ASSERT(false); + return nullptr; + } + } + + ASR::expr_t *Lt(ASR::expr_t *left, ASR::expr_t *right) { + LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); + if (is_real(*expr_type(left))) { + return fLt(left, right); + } else if (is_integer(*expr_type(left))) { + return iLt(left, right); + } else { + LCOMPILERS_ASSERT(false); + return nullptr; + } + } + + ASR::stmt_t *If(ASR::expr_t *a_test, std::vector if_body, + std::vector else_body) { + Vec m_if_body; m_if_body.reserve(al, 1); + for (auto &x: if_body) m_if_body.push_back(al, x); + + Vec m_else_body; m_else_body.reserve(al, 1); + for (auto &x: else_body) m_else_body.push_back(al, x); + + return STMT(ASR::make_If_t(al, loc, a_test, m_if_body.p, m_if_body.n, + m_else_body.p, m_else_body.n)); + } + + ASR::stmt_t *While(ASR::expr_t *a_test, std::vector body) { + Vec m_body; m_body.reserve(al, 1); + for (auto &x: body) m_body.push_back(al, x); + + return STMT(ASR::make_WhileLoop_t(al, loc, nullptr, a_test, + m_body.p, m_body.n, nullptr, 0)); + } + + ASR::stmt_t *Exit(char* loop_name) { + return STMT(ASR::make_Exit_t(al, loc, loop_name)); + } + + ASR::expr_t *TupleConstant(std::vector ele, ASR::ttype_t *type) { + Vec m_ele; m_ele.reserve(al, 3); + for (auto &x: ele) m_ele.push_back(al, x); + return EXPR(ASR::make_TupleConstant_t(al, loc, m_ele.p, m_ele.n, type)); + } + + #define make_Compare(Constructor, left, op, right) ASRUtils::EXPR(ASR::Constructor( \ + al, loc, left, ASR::cmpopType::op, right, \ + ASRUtils::TYPE(ASR::make_Logical_t( \ + al, loc, 4)), nullptr)); \ + + #define create_ElementalBinOp(OpType, BinOpName, OpName, value) case ASR::ttypeType::OpType: { \ + return ASRUtils::EXPR(ASR::BinOpName(al, loc, \ + left, ASR::binopType::OpName, right, \ + ASRUtils::expr_type(left), value)); \ + } \ + + ASR::expr_t* ElementalAdd(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + ASR::ttype_t *left_type = ASRUtils::expr_type(left); + left_type = ASRUtils::type_get_past_pointer(left_type); + switch (left_type->type) { + create_ElementalBinOp(Real, make_RealBinOp_t, Add, value) + create_ElementalBinOp(Integer, make_IntegerBinOp_t, Add, value) + create_ElementalBinOp(Complex, make_ComplexBinOp_t, Add, value) + default: { + throw LCompilersException("Expression type, " + + std::to_string(left_type->type) + + " not yet supported"); + } + } + } + + ASR::expr_t* ElementalSub(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + switch (ASRUtils::expr_type(left)->type) { + create_ElementalBinOp(Real, make_RealBinOp_t, Sub, value) + create_ElementalBinOp(Integer, make_IntegerBinOp_t, Sub, value) + create_ElementalBinOp(Complex, make_ComplexBinOp_t, Sub, value) + default: { + throw LCompilersException("Expression type, " + + std::to_string(expr_type(left)->type) + + " not yet supported"); + } + } + } + + ASR::expr_t* ElementalDiv(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + switch (ASRUtils::expr_type(left)->type) { + create_ElementalBinOp(Real, make_RealBinOp_t, Div, value) + create_ElementalBinOp(Integer, make_IntegerBinOp_t, Div, value) + create_ElementalBinOp(Complex, make_ComplexBinOp_t, Div, value) + default: { + throw LCompilersException("Expression type, " + + std::to_string(expr_type(left)->type) + + " not yet supported"); + } + } + } + + ASR::expr_t* ElementalMul(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + switch (ASRUtils::expr_type(left)->type) { + create_ElementalBinOp(Real, make_RealBinOp_t, Mul, value) + create_ElementalBinOp(Integer, make_IntegerBinOp_t, Mul, value) + create_ElementalBinOp(Complex, make_ComplexBinOp_t, Mul, value) + default: { + throw LCompilersException("Expression type, " + + std::to_string(expr_type(left)->type) + + " not yet supported"); + } + } + } + + ASR::expr_t* ElementalPow(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + switch (ASRUtils::expr_type(left)->type) { + create_ElementalBinOp(Real, make_RealBinOp_t, Pow, value) + create_ElementalBinOp(Integer, make_IntegerBinOp_t, Pow, value) + create_ElementalBinOp(Complex, make_ComplexBinOp_t, Pow, value) + default: { + throw LCompilersException("Expression type, " + + std::to_string(expr_type(left)->type) + + " not yet supported"); + } + } + } + + ASR::expr_t* ElementalMax(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + ASR::expr_t* test_condition = nullptr; + switch (ASRUtils::expr_type(left)->type) { + case ASR::ttypeType::Integer: { + test_condition = make_Compare(make_IntegerCompare_t, left, Gt, right); + break; + } + case ASR::ttypeType::Real: { + test_condition = make_Compare(make_RealCompare_t, left, Gt, right); + break; + } + default: { + throw LCompilersException("Expression type, " + + std::to_string(expr_type(left)->type) + " not yet supported"); + } + } + return ASRUtils::EXPR(ASR::make_IfExp_t(al, loc, test_condition, left, right, ASRUtils::expr_type(left), value)); + } + + ASR::expr_t* ElementalMin(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc, ASR::expr_t* value=nullptr) { + ASR::expr_t* test_condition = nullptr; + switch (ASRUtils::expr_type(left)->type) { + case ASR::ttypeType::Integer: { + test_condition = make_Compare(make_IntegerCompare_t, left, Lt, right); + break; + } + case ASR::ttypeType::Real: { + test_condition = make_Compare(make_RealCompare_t, left, Lt, right); + break; + } + default: { + throw LCompilersException("Expression type, " + + std::to_string(expr_type(left)->type) + " not yet supported"); + } + } + return ASRUtils::EXPR(ASR::make_IfExp_t(al, loc, test_condition, left, right, ASRUtils::expr_type(left), value)); + } + + ASR::expr_t* ElementalOr(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc) { + return ASRUtils::EXPR(ASR::make_LogicalBinOp_t(al, loc, + left, ASR::Or, right, + ASRUtils::TYPE(ASR::make_Logical_t( al, loc, 4)), nullptr)); + } + + ASR::expr_t* LogicalOr(ASR::expr_t* left, ASR::expr_t* right, + const Location& loc) { + return ASRUtils::EXPR(ASR::make_LogicalBinOp_t(al, loc, + left, ASR::Or, right, ASRUtils::expr_type(left), + nullptr)); + } + + ASR::expr_t* Call(ASR::symbol_t* s, Vec& args, + ASR::ttype_t* return_type) { + return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, + s, s, args.p, args.size(), return_type, nullptr, nullptr)); + } + + ASR::expr_t* Call(ASR::symbol_t* s, Vec& args, + ASR::ttype_t* return_type) { + Vec args_; args_.reserve(al, 2); + visit_expr_list(al, args, args_); + return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, + s, s, args_.p, args_.size(), return_type, nullptr, nullptr)); + } + + ASR::expr_t* Call(ASR::symbol_t* s, Vec& args, + ASR::ttype_t* return_type, ASR::expr_t* value) { + return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, + s, s, args.p, args.size(), return_type, value, nullptr)); + } + + ASR::stmt_t* SubroutineCall(ASR::symbol_t* s, Vec& args) { + return ASRUtils::STMT(ASRUtils::make_SubroutineCall_t_util(al, loc, + s, s, args.p, args.size(), nullptr, nullptr, false, false)); + } + + ASR::expr_t *ArrayItem_01(ASR::expr_t *arr, std::vector idx) { + Vec idx_vars; idx_vars.reserve(al, 1); + for (auto &x: idx) idx_vars.push_back(al, x); + return PassUtils::create_array_ref(arr, idx_vars, al); + } + + #define ArrayItem_02(arr, idx_vars) PassUtils::create_array_ref(arr, \ + idx_vars, al) + + ASR::expr_t *ArrayConstant(std::vector elements, + ASR::ttype_t *base_type, bool cast2descriptor=true) { + // This function only creates array with rank one + // TODO: Support other dimensions + Vec m_eles; m_eles.reserve(al, 1); + for (auto &x: elements) m_eles.push_back(al, x); + + ASR::ttype_t *fixed_size_type = Array({(int64_t) elements.size()}, base_type); + ASR::expr_t *arr_constant = EXPR(ASR::make_ArrayConstant_t(al, loc, + m_eles.p, m_eles.n, fixed_size_type, ASR::arraystorageType::ColMajor)); + + if (cast2descriptor) { + return cast_to_descriptor(al, arr_constant); + } else { + return arr_constant; + } + } + + ASR::dimension_t set_dim(ASR::expr_t *start, ASR::expr_t *length) { + ASR::dimension_t dim; + dim.loc = loc; + dim.m_start = start; + dim.m_length = length; + return dim; + } + + // Statements -------------------------------------------------------------- + #define Return() STMT(ASR::make_Return_t(al, loc)) + + ASR::stmt_t *Assignment(ASR::expr_t *lhs, ASR::expr_t *rhs) { + LCOMPILERS_ASSERT(check_equal_type(expr_type(lhs), expr_type(rhs))); + return STMT(ASR::make_Assignment_t(al, loc, lhs, rhs, nullptr)); + } + + template + ASR::stmt_t *Assign_Constant(ASR::expr_t *lhs, T init_value) { + ASR::ttype_t *type = expr_type(lhs); + switch(type->type) { + case ASR::ttypeType::Integer : { + return Assignment(lhs, i(init_value, type)); + } + case ASR::ttypeType::Real : { + return Assignment(lhs, f(init_value, type)); + } + case ASR::ttypeType::Complex : { + return Assignment(lhs, complex(init_value, init_value, type)); + } + default : { + LCOMPILERS_ASSERT(false); + return nullptr; + } + } + } + + ASR::stmt_t *Allocate(ASR::expr_t *m_a, Vec dims) { + Vec alloc_args; alloc_args.reserve(al, 1); + ASR::alloc_arg_t alloc_arg; + alloc_arg.loc = loc; + alloc_arg.m_a = m_a; + alloc_arg.m_dims = dims.p; + alloc_arg.n_dims = dims.n; + alloc_arg.m_type = nullptr; + alloc_arg.m_len_expr = nullptr; + alloc_args.push_back(al, alloc_arg); + return STMT(ASR::make_Allocate_t(al, loc, alloc_args.p, 1, + nullptr, nullptr, nullptr)); + } + + #define UBound(arr, dim) PassUtils::get_bound(arr, dim, "ubound", al) + #define LBound(arr, dim) PassUtils::get_bound(arr, dim, "lbound", al) + + ASR::stmt_t *DoLoop(ASR::expr_t *m_v, ASR::expr_t *start, ASR::expr_t *end, + std::vector loop_body, ASR::expr_t *step=nullptr) { + ASR::do_loop_head_t head; + head.loc = m_v->base.loc; + head.m_v = m_v; + head.m_start = start; + head.m_end = end; + head.m_increment = step; + Vec body; + body.from_pointer_n_copy(al, &loop_body[0], loop_body.size()); + return STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, body.p, body.n, nullptr, 0)); + } + + template + ASR::stmt_t* create_do_loop( + const Location& loc, int rank, ASR::expr_t* array, + SymbolTable* scope, Vec& idx_vars, + Vec& doloop_body, LOOP_BODY loop_body) { + PassUtils::create_idx_vars(idx_vars, rank, loc, al, scope, "_i"); + + ASR::stmt_t* doloop = nullptr; + for( int i = (int) idx_vars.size() - 1; i >= 0; i-- ) { + ASR::do_loop_head_t head; + head.m_v = idx_vars[i]; + head.m_start = PassUtils::get_bound(array, i + 1, "lbound", al); + head.m_end = PassUtils::get_bound(array, i + 1, "ubound", al); + head.m_increment = nullptr; + + head.loc = head.m_v->base.loc; + doloop_body.reserve(al, 1); + if( doloop == nullptr ) { + loop_body(); + } else { + doloop_body.push_back(al, doloop); + } + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, + head, doloop_body.p, doloop_body.size(), nullptr, 0)); + } + return doloop; + } + + template + ASR::stmt_t* create_do_loop( + const Location& loc, ASR::expr_t* array, + Vec& loop_vars, std::vector& loop_dims, + Vec& doloop_body, LOOP_BODY loop_body) { + + ASR::stmt_t* doloop = nullptr; + for( int i = (int) loop_vars.size() - 1; i >= 0; i-- ) { + ASR::do_loop_head_t head; + head.m_v = loop_vars[i]; + head.m_start = PassUtils::get_bound(array, loop_dims[i], "lbound", al); + head.m_end = PassUtils::get_bound(array, loop_dims[i], "ubound", al); + head.m_increment = nullptr; + + head.loc = head.m_v->base.loc; + doloop_body.reserve(al, 1); + if( doloop == nullptr ) { + loop_body(); + } else { + doloop_body.push_back(al, doloop); + } + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, + head, doloop_body.p, doloop_body.size(), nullptr, 0)); + } + return doloop; + } + + template + void generate_reduction_intrinsic_stmts_for_scalar_output(const Location& loc, + ASR::expr_t* array, SymbolTable* fn_scope, + Vec& fn_body, Vec& idx_vars, + Vec& doloop_body, INIT init_stmts, LOOP_BODY loop_body) { + init_stmts(); + int rank = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(array)); + ASR::stmt_t* doloop = create_do_loop(loc, + rank, array, fn_scope, idx_vars, doloop_body, + loop_body); + fn_body.push_back(al, doloop); + } + + template + void generate_reduction_intrinsic_stmts_for_array_output(const Location& loc, + ASR::expr_t* array, ASR::expr_t* dim, SymbolTable* fn_scope, + Vec& fn_body, Vec& idx_vars, + Vec& target_idx_vars, Vec& doloop_body, + INIT init_stmts, LOOP_BODY loop_body) { + init_stmts(); + int n_dims = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(array)); + ASR::stmt_t** else_ = nullptr; + size_t else_n = 0; + idx_vars.reserve(al, n_dims); + PassUtils::create_idx_vars(idx_vars, n_dims, loc, al, fn_scope, "_j"); + for( int i = 1; i <= n_dims; i++ ) { + ASR::expr_t* current_dim = i32(i); + ASR::expr_t* test_expr = make_Compare(make_IntegerCompare_t, dim, + Eq, current_dim); + + Vec loop_vars; + std::vector loop_dims; + loop_dims.reserve(n_dims); + loop_vars.reserve(al, n_dims); + target_idx_vars.reserve(al, n_dims - 1); + for( int j = 1; j <= n_dims; j++ ) { + if( j == i ) { + continue ; + } + target_idx_vars.push_back(al, idx_vars[j - 1]); + loop_dims.push_back(j); + loop_vars.push_back(al, idx_vars[j - 1]); + } + loop_dims.push_back(i); + loop_vars.push_back(al, idx_vars[i - 1]); + + ASR::stmt_t* doloop = create_do_loop(loc, + array, loop_vars, loop_dims, doloop_body, + loop_body); + Vec if_body; + if_body.reserve(al, 1); + if_body.push_back(al, doloop); + ASR::stmt_t* if_ = ASRUtils::STMT(ASR::make_If_t(al, loc, test_expr, + if_body.p, if_body.size(), else_, else_n)); + Vec if_else_if; + if_else_if.reserve(al, 1); + if_else_if.push_back(al, if_); + else_ = if_else_if.p; + else_n = if_else_if.size(); + } + fn_body.push_back(al, else_[0]); + } + + ASR::stmt_t *Print(std::vector items) { + // Used for debugging + Vec x_exprs; + x_exprs.from_pointer_n_copy(al, &items[0], items.size()); + return STMT(ASR::make_Print_t(al, loc, x_exprs.p, x_exprs.n, + nullptr, nullptr)); + } + +}; + +} // namespace LCompilers::ASRUtils + +#endif // LIBASR_BUILDER_H diff --git a/src/libasr/asr_utils.cpp b/src/libasr/asr_utils.cpp index 9210da2..009076b 100644 --- a/src/libasr/asr_utils.cpp +++ b/src/libasr/asr_utils.cpp @@ -483,7 +483,7 @@ ASR::asr_t* getStructInstanceMember_t(Allocator& al, const Location& loc, ASR::ttype_t* member_type = ASRUtils::TYPE(ASR::make_Struct_t(al, member_variable->base.base.loc, mem_es)); return ASR::make_StructInstanceMember_t(al, loc, ASRUtils::EXPR(v_var), - mem_es, member_type, nullptr); + mem_es, ASRUtils::fix_scoped_type(al, member_type, current_scope), nullptr); } else { LCOMPILERS_ASSERT(ASR::is_a(*member)); ASR::Variable_t* member_variable = ASR::down_cast(member); @@ -573,7 +573,7 @@ ASR::asr_t* getStructInstanceMember_t(Allocator& al, const Location& loc, } } return ASR::make_StructInstanceMember_t(al, loc, ASRUtils::EXPR(v_var), - member_ext, member_type, value); + member_ext, ASRUtils::fix_scoped_type(al, member_type, current_scope), value); } } @@ -650,9 +650,16 @@ bool use_overloaded(ASR::expr_t* left, ASR::expr_t* right, } ASR::ttype_t *return_type = nullptr; if( ASRUtils::get_FunctionType(func)->m_elemental && - func->n_args == 1 && + func->n_args >= 1 && ASRUtils::is_array(ASRUtils::expr_type(a_args[0].m_value)) ) { - return_type = ASRUtils::duplicate_type(al, ASRUtils::expr_type(a_args[0].m_value)); + ASR::dimension_t* array_dims; + size_t array_n_dims = ASRUtils::extract_dimensions_from_ttype( + ASRUtils::expr_type(a_args[0].m_value), array_dims); + Vec new_dims; + new_dims.from_pointer_n_copy(al, array_dims, array_n_dims); + return_type = ASRUtils::duplicate_type(al, + ASRUtils::get_FunctionType(func)->m_return_var_type, + &new_dims); } else { return_type = ASRUtils::expr_type(func->m_return_var); bool is_array = ASRUtils::is_array(return_type); @@ -734,9 +741,16 @@ void process_overloaded_unary_minus_function(ASR::symbol_t* proc, ASR::expr_t* o } ASR::ttype_t *return_type = nullptr; if( ASRUtils::get_FunctionType(func)->m_elemental && - func->n_args == 1 && + func->n_args >= 1 && ASRUtils::is_array(ASRUtils::expr_type(a_args[0].m_value)) ) { - return_type = ASRUtils::duplicate_type(al, ASRUtils::expr_type(a_args[0].m_value)); + ASR::dimension_t* array_dims; + size_t array_n_dims = ASRUtils::extract_dimensions_from_ttype( + ASRUtils::expr_type(a_args[0].m_value), array_dims); + Vec new_dims; + new_dims.from_pointer_n_copy(al, array_dims, array_n_dims); + return_type = ASRUtils::duplicate_type(al, + ASRUtils::get_FunctionType(func)->m_return_var_type, + &new_dims); } else { return_type = ASRUtils::expr_type(func->m_return_var); bool is_array = ASRUtils::is_array(return_type); @@ -941,7 +955,7 @@ void process_overloaded_assignment_function(ASR::symbol_t* proc, ASR::expr_t* ta ASRUtils::insert_module_dependency(a_name, al, current_module_dependencies); ASRUtils::set_absent_optional_arguments_to_null(a_args, subrout, al); asr = ASRUtils::make_SubroutineCall_t_util(al, loc, a_name, sym, - a_args.p, 2, nullptr, nullptr, false); + a_args.p, 2, nullptr, nullptr, false, false); } } } @@ -974,7 +988,7 @@ bool use_overloaded_assignment(ASR::expr_t* target, ASR::expr_t* value, ASR::symbol_t* orig_sym = ASRUtils::symbol_get_past_external(sym); ASR::CustomOperator_t* gen_proc = ASR::down_cast(orig_sym); for( size_t i = 0; i < gen_proc->n_procs && !found; i++ ) { - ASR::symbol_t* proc = gen_proc->m_procs[i]; + ASR::symbol_t* proc = ASRUtils::symbol_get_past_external(gen_proc->m_procs[i]); switch( proc->type ) { case ASR::symbolType::Function: { process_overloaded_assignment_function(proc, target, value, target_type, @@ -993,7 +1007,103 @@ bool use_overloaded_assignment(ASR::expr_t* target, ASR::expr_t* value, break; } default: { - err("Only functions and class procedures can be used for generic assignment statement", loc); + err("Only functions and class procedures can be used for generic assignment statement, found " + std::to_string(proc->type), loc); + } + } + } + } + return found; +} + +void process_overloaded_read_write_function(std::string &read_write, ASR::symbol_t* proc, Vec &args, + ASR::ttype_t* arg_type, bool& found, Allocator& al, const Location& arg_loc, + SymbolTable* curr_scope, SetChar& current_function_dependencies, + SetChar& current_module_dependencies, ASR::asr_t*& asr, ASR::symbol_t* sym, const Location& loc, ASR::expr_t* expr_dt, + const std::function err, char* pass_arg=nullptr) { + ASR::Function_t* subrout = ASR::down_cast(proc); + std::string matched_subrout_name = ""; + ASR::ttype_t* func_arg_type = ASRUtils::expr_type(subrout->m_args[0]); + if( ASRUtils::types_equal(func_arg_type, arg_type) ) { + std::string arg0_name = ASRUtils::symbol_name(ASR::down_cast(subrout->m_args[0])->m_v); + if( pass_arg != nullptr ) { + std::string pass_arg_str = std::string(pass_arg); + if( (arg0_name == pass_arg_str && args[0] != expr_dt) ) { + err(std::string(subrout->m_name) + " is not a procedure of " + + ASRUtils::type_to_str(arg_type), + loc); + } + } + found = true; + Vec a_args; + a_args.reserve(al, args.size()); + for (size_t i = 0; i < args.size(); i++) { + ASR::call_arg_t arg; + arg.loc = arg_loc; + arg.m_value = args[i]; + a_args.push_back(al, arg); + } + std::string subrout_name = to_lower(subrout->m_name); + if( curr_scope->resolve_symbol(subrout_name) ) { + matched_subrout_name = subrout_name; + } else { + std::string mangled_name = subrout_name + "@" + read_write; + matched_subrout_name = mangled_name; + } + ASR::symbol_t *a_name = curr_scope->resolve_symbol(matched_subrout_name); + if( a_name == nullptr ) { + err("Unable to resolve matched subroutine for read/write overloading, " + matched_subrout_name, loc); + } + if (ASRUtils::symbol_parent_symtab(a_name)->get_counter() != curr_scope->get_counter()) { + ADD_ASR_DEPENDENCIES_WITH_NAME(curr_scope, a_name, current_function_dependencies, s2c(al, matched_subrout_name)); + } + ASRUtils::insert_module_dependency(a_name, al, current_module_dependencies); + ASRUtils::set_absent_optional_arguments_to_null(a_args, subrout, al); + asr = ASRUtils::make_SubroutineCall_t_util(al, loc, a_name, sym, + a_args.p, a_args.n, nullptr, nullptr, false, false); + } +} + +bool use_overloaded_file_read_write(std::string &read_write, Vec args, + SymbolTable* curr_scope, ASR::asr_t*& asr, + Allocator &al, const Location& loc, + SetChar& current_function_dependencies, + SetChar& current_module_dependencies, + const std::function err) { + ASR::ttype_t *arg_type = ASRUtils::type_get_past_allocatable(ASRUtils::expr_type(args[0])); + bool found = false; + ASR::symbol_t* sym = curr_scope->resolve_symbol(read_write); + ASR::expr_t* expr_dt = nullptr; + if( sym == nullptr ) { + if( ASR::is_a(*arg_type) ) { + ASR::StructType_t* arg_struct = ASR::down_cast( + ASRUtils::symbol_get_past_external(ASR::down_cast(arg_type)->m_derived_type)); + sym = arg_struct->m_symtab->resolve_symbol(read_write); + expr_dt = args[0]; + } + } else { + ASR::symbol_t* orig_sym = ASRUtils::symbol_get_past_external(sym); + ASR::CustomOperator_t* gen_proc = ASR::down_cast(orig_sym); + for( size_t i = 0; i < gen_proc->n_procs && !found; i++ ) { + ASR::symbol_t* proc = ASRUtils::symbol_get_past_external(gen_proc->m_procs[i]); + switch( proc->type ) { + case ASR::symbolType::Function: { + process_overloaded_read_write_function(read_write, proc, args, arg_type, + found, al, args[0]->base.loc, curr_scope, + current_function_dependencies, current_module_dependencies, asr, sym, + loc, expr_dt, err); + break; + } + case ASR::symbolType::ClassProcedure: { + ASR::ClassProcedure_t* class_proc = ASR::down_cast(proc); + ASR::symbol_t* proc_func = ASR::down_cast(proc)->m_proc; + process_overloaded_read_write_function(read_write, proc_func, args, arg_type, + found, al, args[0]->base.loc, curr_scope, + current_function_dependencies, current_module_dependencies, asr, proc_func, loc, + expr_dt, err, class_proc->m_self_argument); + break; + } + default: { + err("Only functions and class procedures can be used for generic read/write statement, found " + std::to_string(proc->type), loc); } } } @@ -1035,7 +1145,7 @@ bool use_overloaded(ASR::expr_t* left, ASR::expr_t* right, ASR::down_cast( gen_proc->m_procs[i])->m_proc); } else { - proc = gen_proc->m_procs[i]; + proc = ASRUtils::symbol_get_past_external(gen_proc->m_procs[i]); } switch(proc->type) { case ASR::symbolType::Function: { @@ -1071,9 +1181,16 @@ bool use_overloaded(ASR::expr_t* left, ASR::expr_t* right, } ASR::ttype_t *return_type = nullptr; if( ASRUtils::get_FunctionType(func)->m_elemental && - func->n_args == 1 && + func->n_args >= 1 && ASRUtils::is_array(ASRUtils::expr_type(a_args[0].m_value)) ) { - return_type = ASRUtils::duplicate_type(al, ASRUtils::expr_type(a_args[0].m_value)); + ASR::dimension_t* array_dims; + size_t array_n_dims = ASRUtils::extract_dimensions_from_ttype( + ASRUtils::expr_type(a_args[0].m_value), array_dims); + Vec new_dims; + new_dims.from_pointer_n_copy(al, array_dims, array_n_dims); + return_type = ASRUtils::duplicate_type(al, + ASRUtils::get_FunctionType(func)->m_return_var_type, + &new_dims); } else { return_type = ASRUtils::expr_type(func->m_return_var); } @@ -1169,7 +1286,7 @@ bool argument_types_match(const Vec& args, // Otherwise this should not be nullptr ASR::ttype_t *arg1 = ASRUtils::expr_type(args[i].m_value); ASR::ttype_t *arg2 = v->m_type; - if (!types_equal(arg1, arg2)) { + if (!types_equal(arg1, arg2, !ASRUtils::get_FunctionType(sub)->m_elemental)) { return false; } } @@ -1201,30 +1318,6 @@ bool select_func_subrout(const ASR::symbol_t* proc, const Vec& return result; } -int select_generic_procedure(const Vec& args, - const ASR::GenericProcedure_t &p, Location loc, - const std::function err, - bool raise_error) { - for (size_t i=0; i < p.n_procs; i++) { - if( ASR::is_a(*p.m_procs[i]) ) { - ASR::ClassProcedure_t *clss_fn - = ASR::down_cast(p.m_procs[i]); - const ASR::symbol_t *proc = ASRUtils::symbol_get_past_external(clss_fn->m_proc); - if( select_func_subrout(proc, args, loc, err) ) { - return i; - } - } else { - if( select_func_subrout(p.m_procs[i], args, loc, err) ) { - return i; - } - } - } - if( raise_error ) { - err("Arguments do not match for any generic procedure, " + std::string(p.m_name), loc); - } - return -1; -} - ASR::asr_t* symbol_resolve_external_generic_procedure_without_eval( const Location &loc, ASR::symbol_t *v, Vec& args, @@ -1244,9 +1337,16 @@ ASR::asr_t* symbol_resolve_external_generic_procedure_without_eval( func = ASR::down_cast(final_sym); if (func->m_return_var) { if( ASRUtils::get_FunctionType(func)->m_elemental && - func->n_args == 1 && + func->n_args >= 1 && ASRUtils::is_array(ASRUtils::expr_type(args[0].m_value)) ) { - return_type = ASRUtils::duplicate_type(al, ASRUtils::expr_type(args[0].m_value)); + ASR::dimension_t* array_dims; + size_t array_n_dims = ASRUtils::extract_dimensions_from_ttype( + ASRUtils::expr_type(args[0].m_value), array_dims); + Vec new_dims; + new_dims.from_pointer_n_copy(al, array_dims, array_n_dims); + return_type = ASRUtils::duplicate_type(al, + ASRUtils::get_FunctionType(func)->m_return_var_type, + &new_dims); } else { return_type = ASRUtils::EXPR2VAR(func->m_return_var)->m_type; } @@ -1283,7 +1383,7 @@ ASR::asr_t* symbol_resolve_external_generic_procedure_without_eval( } return ASRUtils::make_SubroutineCall_t_util(al, loc, final_sym, v, args.p, args.size(), - nullptr, nullptr, false); + nullptr, nullptr, false, false); } else { if( func ) { ASRUtils::set_absent_optional_arguments_to_null(args, func, al); @@ -1343,7 +1443,9 @@ ASR::asr_t* make_Cast_t_value(Allocator &al, const Location &a_loc, ASRUtils::expr_value(a_arg))->m_n; value = ASR::down_cast(ASR::make_UnsignedIntegerConstant_t(al, a_loc, int_value, a_type)); } else if (a_kind == ASR::cast_kindType::IntegerToLogical) { - // TODO: implement + int64_t int_value = ASR::down_cast( + ASRUtils::expr_value(a_arg))->m_n; + value = ASR::down_cast(ASR::make_LogicalConstant_t(al, a_loc, int_value, a_type)); } else if (a_kind == ASR::cast_kindType::ComplexToComplex) { ASR::ComplexConstant_t* value_complex = ASR::down_cast( ASRUtils::expr_value(a_arg)); @@ -1362,10 +1464,9 @@ ASR::asr_t* make_Cast_t_value(Allocator &al, const Location &a_loc, args.reserve(al, 1); args.push_back(al, a_arg); LCompilers::ASRUtils::create_intrinsic_function create_function = - LCompilers::ASRUtils::IntrinsicScalarFunctionRegistry::get_create_function("SymbolicInteger"); - value = ASR::down_cast(create_function(al, a_loc, args, - [](const std::string&, const Location&) { - })); + LCompilers::ASRUtils::IntrinsicElementalFunctionRegistry::get_create_function("SymbolicInteger"); + diag::Diagnostics diag; + value = ASR::down_cast(create_function(al, a_loc, args, diag)); } } @@ -1374,7 +1475,9 @@ ASR::asr_t* make_Cast_t_value(Allocator &al, const Location &a_loc, ASR::symbol_t* import_class_procedure(Allocator &al, const Location& loc, ASR::symbol_t* original_sym, SymbolTable *current_scope) { - if( original_sym && ASR::is_a(*original_sym) ) { + if( original_sym && (ASR::is_a(*original_sym) || + (ASR::is_a(*original_sym) && + ASR::is_a(*ASRUtils::symbol_type(original_sym)))) ) { std::string class_proc_name = ASRUtils::symbol_name(original_sym); if( original_sym != current_scope->resolve_symbol(class_proc_name) ) { std::string imported_proc_name = "1_" + class_proc_name; @@ -1461,10 +1564,9 @@ void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, size_t expr1_ndims) { ASR::ttype_t* expr1_type = ASRUtils::expr_type(expr1); Vec shape_args; - shape_args.reserve(al, 2); + shape_args.reserve(al, 1); shape_args.push_back(al, expr1); - shape_args.push_back(al, - make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, 4, 4, loc)); + bool is_value_character_array = ASRUtils::is_character(*ASRUtils::expr_type(expr2)); Vec dims; dims.reserve(al, 1); @@ -1477,7 +1579,7 @@ void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, dims.push_back(al, dim); ASR::ttype_t* dest_shape_type = ASRUtils::TYPE(ASR::make_Array_t(al, loc, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), dims.p, dims.size(), - ASR::array_physical_typeType::FixedSizeArray)); + is_value_character_array ? ASR::array_physical_typeType::CharacterArraySinglePointer: ASR::array_physical_typeType::FixedSizeArray)); ASR::expr_t* dest_shape = nullptr; ASR::expr_t* value = nullptr; @@ -1487,8 +1589,8 @@ void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, for( size_t i = 0; i < expr1_ndims; i++ ) { lengths.push_back(al, ASRUtils::expr_value(expr1_mdims[i].m_length)); } - dest_shape = ASRUtils::EXPR(ASR::make_ArrayConstant_t(al, loc, - lengths.p, lengths.size(), dest_shape_type, ASR::arraystorageType::ColMajor)); + dest_shape = EXPR(ASRUtils::make_ArrayConstructor_t_util(al, loc, lengths.p, + lengths.size(), dest_shape_type, ASR::arraystorageType::ColMajor)); Vec dims; dims.reserve(al, 1); ASR::dimension_t dim; @@ -1504,14 +1606,14 @@ void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, ASRUtils::get_fixed_size_of_array(expr1_mdims, expr1_ndims) <= 256 ) { ASR::ttype_t* value_type = ASRUtils::TYPE(ASR::make_Array_t(al, loc, ASRUtils::type_get_past_array(ASRUtils::expr_type(expr2)), dims.p, dims.size(), - ASR::array_physical_typeType::FixedSizeArray)); + is_value_character_array ? ASR::array_physical_typeType::CharacterArraySinglePointer: ASR::array_physical_typeType::FixedSizeArray)); Vec values; values.reserve(al, ASRUtils::get_fixed_size_of_array(expr1_mdims, expr1_ndims)); for( int64_t i = 0; i < ASRUtils::get_fixed_size_of_array(expr1_mdims, expr1_ndims); i++ ) { values.push_back(al, expr2); } - value = ASRUtils::EXPR(ASR::make_ArrayConstant_t(al, loc, - values.p, values.size(), value_type, ASR::arraystorageType::ColMajor)); + value = EXPR(ASRUtils::make_ArrayConstructor_t_util(al, loc, values.p, + values.size(), value_type, ASR::arraystorageType::ColMajor)); ret_type = value_type; } } else { @@ -1523,7 +1625,12 @@ void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, if (ret_type == nullptr) { // TODO: Construct appropriate return type here // For now simply coping the type from expr1 - ret_type = expr1_type; + if (ASRUtils::is_simd_array(expr1)) { + // TODO: Make this more general; do not check for SIMDArray + ret_type = ASRUtils::duplicate_type(al, expr1_type); + } else { + ret_type = expr1_type; + } } expr2 = ASRUtils::EXPR(ASR::make_ArrayBroadcast_t(al, loc, expr2, dest_shape, ret_type, value)); @@ -1559,10 +1666,12 @@ void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, } } -int64_t compute_trailing_zeros(int64_t number) { +int64_t compute_trailing_zeros(int64_t number, int64_t kind) { int64_t trailing_zeros = 0; - if (number == 0) { + if (number == 0 && kind == 4) { return 32; + } else if (number == 0 && kind == 8) { + return 64; } while (number % 2 == 0) { number = number / 2; @@ -1571,6 +1680,30 @@ int64_t compute_trailing_zeros(int64_t number) { return trailing_zeros; } +int64_t compute_leading_zeros(int64_t number, int64_t kind) { + int64_t leading_zeros = 0; + int64_t total_bits = 32; + if (kind == 8) total_bits = 64; + if (number < 0) return 0; + while (total_bits > 0) { + if (number%2 == 0) { + leading_zeros++; + } else { + leading_zeros = 0; + } + number = number/2; + total_bits--; + } + return leading_zeros; +} + +void append_error(diag::Diagnostics& diag, const std::string& msg, + const Location& loc) { + diag.add(diag::Diagnostic(msg, diag::Level::Error, + diag::Stage::Semantic, {diag::Label("", { loc })})); +} + + //Initialize pointer to zero so that it can be initialized in first call to get_instance ASRUtils::LabelGenerator* ASRUtils::LabelGenerator::label_generator = nullptr; diff --git a/src/libasr/asr_utils.h b/src/libasr/asr_utils.h index 742c165..9edf568 100644 --- a/src/libasr/asr_utils.h +++ b/src/libasr/asr_utils.h @@ -8,9 +8,9 @@ #include #include -#include #include #include +#include #include @@ -112,6 +112,35 @@ static inline ASR::symbol_t *symbol_get_past_external(ASR::symbol_t *f) } } +template +Location get_vec_loc(const Vec& args) { + LCOMPILERS_ASSERT(args.size() > 0); + Location args_loc; + args_loc.first = args[0].loc.first; + args_loc.last = args[args.size() - 1].loc.last; + return args_loc; +} + +static inline ASR::FunctionType_t* get_FunctionType(ASR::symbol_t* x) { + ASR::symbol_t* a_name_ = ASRUtils::symbol_get_past_external(x); + ASR::FunctionType_t* func_type = nullptr; + if( ASR::is_a(*a_name_) ) { + func_type = ASR::down_cast( + ASR::down_cast(a_name_)->m_function_signature); + } else if( ASR::is_a(*a_name_) ) { + func_type = ASR::down_cast( + ASR::down_cast(a_name_)->m_type); + } else if( ASR::is_a(*a_name_) ) { + ASR::Function_t* func = ASR::down_cast( + ASRUtils::symbol_get_past_external( + ASR::down_cast(a_name_)->m_proc)); + func_type = ASR::down_cast(func->m_function_signature); + } else { + LCOMPILERS_ASSERT(false); + } + return func_type; +} + static inline const ASR::symbol_t *symbol_get_past_external(const ASR::symbol_t *f) { if (f->type == ASR::symbolType::ExternalSymbol) { @@ -149,8 +178,7 @@ static inline ASR::ttype_t *type_get_past_allocatable(ASR::ttype_t *f) { if (ASR::is_a(*f)) { ASR::Allocatable_t *e = ASR::down_cast(f); - LCOMPILERS_ASSERT(!ASR::is_a(*e->m_type)); - return e->m_type; + return type_get_past_allocatable(e->m_type); } else { return f; } @@ -208,6 +236,57 @@ static inline int extract_kind_from_ttype_t(const ASR::ttype_t* type) { } } +static inline void set_kind_to_ttype_t(ASR::ttype_t* type, int kind) { + if (type == nullptr) { + return; + } + switch (type->type) { + case ASR::ttypeType::Array: { + set_kind_to_ttype_t(ASR::down_cast(type)->m_type, kind); + break; + } + case ASR::ttypeType::Integer : { + ASR::down_cast(type)->m_kind = kind; + break; + } + case ASR::ttypeType::UnsignedInteger : { + ASR::down_cast(type)->m_kind = kind; + break; + } + case ASR::ttypeType::Real : { + ASR::down_cast(type)->m_kind = kind; + break; + } + case ASR::ttypeType::Complex: { + ASR::down_cast(type)->m_kind = kind; + break; + } + case ASR::ttypeType::Character: { + ASR::down_cast(type)->m_kind = kind; + break; + } + case ASR::ttypeType::Logical: { + ASR::down_cast(type)->m_kind = kind; + break; + } + case ASR::ttypeType::Pointer: { + set_kind_to_ttype_t(ASR::down_cast(type)->m_type, kind); + break; + } + case ASR::ttypeType::Allocatable: { + set_kind_to_ttype_t(ASR::down_cast(type)->m_type, kind); + break; + } + case ASR::ttypeType::Const: { + set_kind_to_ttype_t(ASR::down_cast(type)->m_type, kind); + break; + } + default : { + return; + } + } +} + static inline ASR::Variable_t* EXPR2VAR(const ASR::expr_t *f) { return ASR::down_cast(symbol_get_past_external( @@ -354,6 +433,15 @@ static inline ASR::abiType expr_abi(ASR::expr_t* e) { case ASR::exprType::GetPointer: { return ASRUtils::expr_abi(ASR::down_cast(e)->m_arg); } + case ASR::exprType::ComplexIm: { + return ASRUtils::expr_abi(ASR::down_cast(e)->m_arg); + } + case ASR::exprType::ComplexRe: { + return ASRUtils::expr_abi(ASR::down_cast(e)->m_arg); + } + case ASR::exprType::ArrayPhysicalCast: { + return ASRUtils::expr_abi(ASR::down_cast(e)->m_arg); + } default: throw LCompilersException("Cannot extract the ABI of " + std::to_string(e->type) + " expression."); @@ -412,6 +500,15 @@ static inline char *symbol_name(const ASR::symbol_t *f) } } +static inline bool get_class_proc_nopass_val(ASR::symbol_t* func_sym) { + func_sym = ASRUtils::symbol_get_past_external(func_sym); + bool nopass = false; + if (ASR::is_a(*func_sym)) { + nopass = ASR::down_cast(func_sym)->m_is_nopass; + } + return nopass; +} + static inline void encode_dimensions(size_t n_dims, std::string& res, bool use_underscore_sep=false) { if( n_dims == 0 ) { @@ -482,9 +579,6 @@ static inline std::string type_to_str(const ASR::ttype_t *t) case ASR::ttypeType::Struct: { return ASRUtils::symbol_name(ASR::down_cast(t)->m_derived_type); } - case ASR::ttypeType::Enum: { - return ASRUtils::symbol_name(ASR::down_cast(t)->m_enum_type); - } case ASR::ttypeType::Class: { return ASRUtils::symbol_name(ASR::down_cast(t)->m_class_type); } @@ -519,10 +613,76 @@ static inline std::string type_to_str(const ASR::ttype_t *t) case ASR::ttypeType::SymbolicExpression: { return "symbolic expression"; } + case ASR::ttypeType::FunctionType: { + ASR::FunctionType_t* ftp = ASR::down_cast(t); + std::string result = "("; + for( size_t i = 0; i < ftp->n_arg_types; i++ ) { + result += type_to_str(ftp->m_arg_types[i]) + ", "; + } + result += "return_type: "; + if( ftp->m_return_var_type ) { + result += type_to_str(ftp->m_return_var_type); + } else { + result += "void"; + } + result += ")"; + return result; + } default : throw LCompilersException("Not implemented " + std::to_string(t->type) + "."); } } +static inline std::string type_to_str_with_type(const ASR::ttype_t *t) { + std::string type = type_to_str(t); + std::string kind = std::to_string(extract_kind_from_ttype_t(t)); + return type + "(" + kind + ")"; +} + +static inline std::string type_to_str_with_substitution(const ASR::ttype_t *t, + std::map subs) +{ + if (ASR::is_a(*t)) { + ASR::TypeParameter_t* t_tp = ASR::down_cast(t); + t = subs[t_tp->m_param]; + } + switch (t->type) { + case ASR::ttypeType::Pointer: { + return type_to_str_with_substitution(ASRUtils::type_get_past_pointer( + const_cast(t)), subs) + " pointer"; + } + case ASR::ttypeType::Allocatable: { + return type_to_str_with_substitution(ASRUtils::type_get_past_allocatable( + const_cast(t)), subs) + " allocatable"; + } + case ASR::ttypeType::Array: { + ASR::Array_t* array_t = ASR::down_cast(t); + std::string res = type_to_str_with_substitution(array_t->m_type, subs); + encode_dimensions(array_t->n_dims, res, false); + return res; + } + case ASR::ttypeType::Const: { + return type_to_str_with_substitution(ASRUtils::get_contained_type( + const_cast(t)), subs) + " const"; + } + case ASR::ttypeType::FunctionType: { + ASR::FunctionType_t* ftp = ASR::down_cast(t); + std::string result = "("; + for( size_t i = 0; i < ftp->n_arg_types; i++ ) { + result += type_to_str_with_substitution(ftp->m_arg_types[i], subs) + ", "; + } + result += "return_type: "; + if( ftp->m_return_var_type ) { + result += type_to_str_with_substitution(ftp->m_return_var_type, subs); + } else { + result += "void"; + } + result += ")"; + return result; + } + default : return type_to_str(t); + } +} + static inline std::string binop_to_str(const ASR::binopType t) { switch (t) { case (ASR::binopType::Add): { return " + "; } @@ -850,99 +1010,113 @@ static inline bool is_value_constant(ASR::expr_t *a_value) { if( a_value == nullptr ) { return false; } - if (ASR::is_a(*a_value)) { - // OK - } else if (ASR::is_a(*a_value)) { - ASR::expr_t *val = ASR::down_cast( - a_value)->m_value; - return is_value_constant(val); - } else if (ASR::is_a(*a_value)) { - // OK - } else if (ASR::is_a(*a_value)) { - // OK - } else if (ASR::is_a(*a_value)) { - ASR::expr_t *val = ASR::down_cast( - a_value)->m_value; - return is_value_constant(val); - } else if (ASR::is_a(*a_value)) { - // OK - } else if (ASR::is_a(*a_value)) { - // OK - } else if (ASR::is_a(*a_value)) { - // OK - } else if(ASR::is_a(*a_value)) { - ASR::ArrayConstant_t* array_constant = ASR::down_cast(a_value); - for( size_t i = 0; i < array_constant->n_args; i++ ) { - if( !ASRUtils::is_value_constant(array_constant->m_args[i]) && - !ASRUtils::is_value_constant(ASRUtils::expr_value(array_constant->m_args[i])) ) { - return false; - } + switch ( a_value->type ) { + case ASR::exprType::IntegerConstant: + case ASR::exprType::IntegerBOZ: + case ASR::exprType::UnsignedIntegerConstant: + case ASR::exprType::RealConstant: + case ASR::exprType::ComplexConstant: + case ASR::exprType::LogicalConstant: + case ASR::exprType::ImpliedDoLoop: + case ASR::exprType::PointerNullConstant: + case ASR::exprType::ArrayConstant: + case ASR::exprType::StringConstant: { + return true; } - return true; - } else if(ASR::is_a(*a_value)) { - ASR::ListConstant_t* list_constant = ASR::down_cast(a_value); - for( size_t i = 0; i < list_constant->n_args; i++ ) { - if( !ASRUtils::is_value_constant(list_constant->m_args[i]) && - !ASRUtils::is_value_constant(ASRUtils::expr_value(list_constant->m_args[i])) ) { + case ASR::exprType::RealBinOp: + case ASR::exprType::IntegerUnaryMinus: + case ASR::exprType::RealUnaryMinus: + case ASR::exprType::IntegerBinOp: + case ASR::exprType::StringLen: { + return is_value_constant(expr_value(a_value)); + } case ASR::exprType::ListConstant: { + ASR::ListConstant_t* list_constant = ASR::down_cast(a_value); + for( size_t i = 0; i < list_constant->n_args; i++ ) { + if( !ASRUtils::is_value_constant(list_constant->m_args[i]) && + !ASRUtils::is_value_constant(ASRUtils::expr_value(list_constant->m_args[i])) ) { + return false; + } + } + return true; + } case ASR::exprType::IntrinsicElementalFunction: { + ASR::IntrinsicElementalFunction_t* intrinsic_elemental_function = + ASR::down_cast(a_value); + + if (ASRUtils::is_value_constant(intrinsic_elemental_function->m_value)) { + return true; + } + + for( size_t i = 0; i < intrinsic_elemental_function->n_args; i++ ) { + if( !ASRUtils::is_value_constant(intrinsic_elemental_function->m_args[i]) ) { + return false; + } + } + + return true; + } case ASR::exprType::FunctionCall: { + ASR::FunctionCall_t* func_call_t = ASR::down_cast(a_value); + if( !ASRUtils::is_intrinsic_symbol(ASRUtils::symbol_get_past_external(func_call_t->m_name)) ) { return false; } - } - return true; - } else if(ASR::is_a(*a_value)) { - ASR::FunctionCall_t* func_call_t = ASR::down_cast(a_value); - if( !ASRUtils::is_intrinsic_symbol(ASRUtils::symbol_get_past_external(func_call_t->m_name)) ) { - return false; - } - for( size_t i = 0; i < func_call_t->n_args; i++ ) { - if( !ASRUtils::is_value_constant(func_call_t->m_args[i].m_value) ) { + + ASR::Function_t* func = ASR::down_cast( + ASRUtils::symbol_get_past_external(func_call_t->m_name)); + for( size_t i = 0; i < func_call_t->n_args; i++ ) { + if (func_call_t->m_args[i].m_value == nullptr && + ASRUtils::EXPR2VAR(func->m_args[i])->m_presence == ASR::presenceType::Optional) { + continue; + } + if( !ASRUtils::is_value_constant(func_call_t->m_args[i].m_value) ) { + return false; + } + } + return true; + } case ASR::exprType::ArrayBroadcast: { + ASR::ArrayBroadcast_t* array_broadcast = ASR::down_cast(a_value); + return is_value_constant(array_broadcast->m_value); + } case ASR::exprType::StructInstanceMember: { + ASR::StructInstanceMember_t* + struct_member_t = ASR::down_cast(a_value); + return is_value_constant(struct_member_t->m_v); + } case ASR::exprType::Var: { + ASR::Var_t* var_t = ASR::down_cast(a_value); + if( ASR::is_a(*ASRUtils::symbol_get_past_external(var_t->m_v)) ) { + ASR::Variable_t* variable_t = ASR::down_cast( + ASRUtils::symbol_get_past_external(var_t->m_v)); + return variable_t->m_storage == ASR::storage_typeType::Parameter; + } else { return false; } + } case ASR::exprType::Cast: { + ASR::Cast_t* cast_t = ASR::down_cast(a_value); + return is_value_constant(cast_t->m_arg); + } case ASR::exprType::ArrayReshape: { + ASR::ArrayReshape_t* + array_reshape = ASR::down_cast(a_value); + return is_value_constant(array_reshape->m_array) && is_value_constant(array_reshape->m_shape); + } case ASR::exprType::ArrayPhysicalCast: { + ASR::ArrayPhysicalCast_t* + array_physical_t = ASR::down_cast(a_value); + return is_value_constant(array_physical_t->m_arg); + } case ASR::exprType::StructTypeConstructor: { + ASR::StructTypeConstructor_t* struct_type_constructor = + ASR::down_cast(a_value); + bool is_constant = true; + for( size_t i = 0; i < struct_type_constructor->n_args; i++ ) { + if( struct_type_constructor->m_args[i].m_value ) { + is_constant = is_constant && + (is_value_constant( + struct_type_constructor->m_args[i].m_value) || + is_value_constant( + ASRUtils::expr_value( + struct_type_constructor->m_args[i].m_value))); + } + } + return is_constant; + } default: { + return false; } - return true; - } else if( ASR::is_a(*a_value) ) { - ASR::StructInstanceMember_t* struct_member_t = ASR::down_cast(a_value); - return is_value_constant(struct_member_t->m_v); - } else if( ASR::is_a(*a_value) ) { - ASR::Var_t* var_t = ASR::down_cast(a_value); - LCOMPILERS_ASSERT(ASR::is_a(*ASRUtils::symbol_get_past_external(var_t->m_v))); - ASR::Variable_t* variable_t = ASR::down_cast( - ASRUtils::symbol_get_past_external(var_t->m_v)); - return variable_t->m_storage == ASR::storage_typeType::Parameter; - - } else if(ASR::is_a(*a_value)) { - // OK - } else if(ASR::is_a(*a_value)) { - ASR::Cast_t* cast_t = ASR::down_cast(a_value); - return is_value_constant(cast_t->m_arg); - } else if(ASR::is_a(*a_value)) { - // OK - } else if(ASR::is_a(*a_value)) { - ASR::ArrayReshape_t* array_reshape = ASR::down_cast(a_value); - return is_value_constant(array_reshape->m_array) && is_value_constant(array_reshape->m_shape); - } else if(ASR::is_a(*a_value)) { - ASR::ArrayPhysicalCast_t* array_physical_t = ASR::down_cast(a_value); - return is_value_constant(array_physical_t->m_arg); - } else if( ASR::is_a(*a_value) ) { - ASR::StructTypeConstructor_t* struct_type_constructor = - ASR::down_cast(a_value); - bool is_constant = true; - for( size_t i = 0; i < struct_type_constructor->n_args; i++ ) { - if( struct_type_constructor->m_args[i].m_value ) { - is_constant = is_constant && - (is_value_constant( - struct_type_constructor->m_args[i].m_value) || - is_value_constant( - ASRUtils::expr_value( - struct_type_constructor->m_args[i].m_value))); - } - } - return is_constant; - } else if( ASR::is_a(*a_value) ) { - return ASR::is_a(*ASRUtils::expr_type(a_value)); - } else { - return false; } - return true; } static inline bool is_value_constant(ASR::expr_t *a_value, int64_t& const_value) { @@ -1050,8 +1224,9 @@ static inline bool is_value_in_range(ASR::expr_t* start, ASR::expr_t* end, ASR:: } // Returns true if all arguments are evaluated -static inline bool all_args_evaluated(const Vec &args) { +static inline bool all_args_evaluated(const Vec &args, bool ignore_null=false) { for (auto &a : args) { + if (ignore_null && !a) continue; ASR::expr_t* a_value = ASRUtils::expr_value(a); if( !is_value_constant(a_value) ) { return false; @@ -1117,6 +1292,39 @@ static inline bool extract_value(ASR::expr_t* value_expr, return true; } +static inline bool extract_string_value(ASR::expr_t* value_expr, + std::string& value) { + if( !is_value_constant(value_expr) ) { + return false; + } + switch (value_expr->type) + { + case ASR::exprType::StringConstant: { + ASR::StringConstant_t* const_string = ASR::down_cast(value_expr); + value = std::string(const_string->m_s); + break; + } + case ASR::exprType::Var: { + ASR::Variable_t* var = EXPR2VAR(value_expr); + if (var->m_storage == ASR::storage_typeType::Parameter + && !extract_string_value(var->m_value, value)) { + return false; + } + break; + } + case ASR::exprType::FunctionCall: { + ASR::FunctionCall_t* func_call = ASR::down_cast(value_expr); + if (!extract_string_value(func_call->m_value, value)) { + return false; + } + break; + } + default: + return false; + } + return true; +} + template >::value == false && @@ -1132,12 +1340,9 @@ static inline bool extract_value(ASR::expr_t* value_expr, T& value) { value = (T) const_int->m_n; break; } - case ASR::exprType::IntegerUnaryMinus: { - ASR::IntegerUnaryMinus_t* - const_int = ASR::down_cast(value_expr); - if (!extract_value(const_int->m_value, value)) { - return false; - } + case ASR::exprType::IntegerBOZ: { + ASR::IntegerBOZ_t* int_boz = ASR::down_cast(value_expr); + value = (T) int_boz->m_v; break; } case ASR::exprType::UnsignedIntegerConstant: { @@ -1150,14 +1355,6 @@ static inline bool extract_value(ASR::expr_t* value_expr, T& value) { value = (T) const_real->m_r; break; } - case ASR::exprType::RealUnaryMinus: { - ASR::RealUnaryMinus_t* - const_int = ASR::down_cast(value_expr); - if (!extract_value(const_int->m_value, value)) { - return false; - } - break; - } case ASR::exprType::LogicalConstant: { ASR::LogicalConstant_t* const_logical = ASR::down_cast(value_expr); value = (T) const_logical->m_value; @@ -1171,6 +1368,16 @@ static inline bool extract_value(ASR::expr_t* value_expr, T& value) { } break; } + case ASR::exprType::IntegerUnaryMinus: + case ASR::exprType::RealUnaryMinus: + case ASR::exprType::FunctionCall: + case ASR::exprType::IntegerBinOp: + case ASR::exprType::StringLen: { + if (!extract_value(expr_value(value_expr), value)) { + return false; + } + break; + } default: return false; } @@ -1625,10 +1832,10 @@ static inline ASR::expr_t* get_minimum_value_with_given_type(Allocator& al, ASR: case ASR::ttypeType::Integer: { int64_t val; switch (kind) { - case 1: val = std::numeric_limits::min(); break; - case 2: val = std::numeric_limits::min(); break; - case 4: val = std::numeric_limits::min(); break; - case 8: val = std::numeric_limits::min(); break; + case 1: val = std::numeric_limits::min()+1; break; + case 2: val = std::numeric_limits::min()+1; break; + case 4: val = std::numeric_limits::min()+1; break; + case 8: val = std::numeric_limits::min()+1; break; default: throw LCompilersException("get_minimum_value_with_given_type: Unsupported integer kind " + std::to_string(kind)); } @@ -1792,6 +1999,13 @@ bool use_overloaded_assignment(ASR::expr_t* target, ASR::expr_t* value, SetChar& /*current_module_dependencies*/, const std::function err); +bool use_overloaded_file_read_write(std::string &read_write, Vec args, + SymbolTable* curr_scope, ASR::asr_t*& asr, + Allocator &al, const Location& loc, + SetChar& current_function_dependencies, + SetChar& /*current_module_dependencies*/, + const std::function err); + void set_intrinsic(ASR::symbol_t* sym); static inline bool is_pointer(ASR::ttype_t *x) { @@ -1800,10 +2014,11 @@ static inline bool is_pointer(ASR::ttype_t *x) { static inline bool is_integer(ASR::ttype_t &x) { return ASR::is_a( - *type_get_past_array( - type_get_past_allocatable( - type_get_past_pointer( - type_get_past_const(&x))))); + *type_get_past_const( + type_get_past_array( + type_get_past_allocatable( + type_get_past_pointer( + type_get_past_const(&x)))))); } static inline bool is_unsigned_integer(ASR::ttype_t &x) { @@ -1839,8 +2054,7 @@ static inline bool is_logical(ASR::ttype_t &x) { return ASR::is_a( *type_get_past_array( type_get_past_allocatable( - type_get_past_pointer( - type_get_past_const(&x))))); + type_get_past_pointer(&x)))); } // Checking if the ttype 't' is a type parameter @@ -1933,9 +2147,9 @@ static inline int get_body_size(ASR::symbol_t* s) { return n_body; } -inline int extract_dimensions_from_ttype(ASR::ttype_t *x, +inline size_t extract_dimensions_from_ttype(ASR::ttype_t *x, ASR::dimension_t*& m_dims) { - int n_dims = 0; + size_t n_dims {}; switch (x->type) { case ASR::ttypeType::Array: { ASR::Array_t* array_t = ASR::down_cast(x); @@ -2111,6 +2325,9 @@ static inline ASR::asr_t* make_ArraySize_t_util( ASR::expr_t* start = array_section_t->m_args[i].m_left; ASR::expr_t* end = array_section_t->m_args[i].m_right; ASR::expr_t* d = array_section_t->m_args[i].m_step; + start = CastingUtil::perform_casting(start, a_type, al, a_loc); + end = CastingUtil::perform_casting(end, a_type, al, a_loc); + d = CastingUtil::perform_casting(d, a_type, al, a_loc); ASR::expr_t* endminusstart = ASRUtils::EXPR(ASR::make_IntegerBinOp_t( al, a_loc, end, ASR::binopType::Sub, start, a_type, nullptr)); ASR::expr_t* byd = ASRUtils::EXPR(ASR::make_IntegerBinOp_t( @@ -2126,6 +2343,9 @@ static inline ASR::asr_t* make_ArraySize_t_util( ASR::expr_t* start = array_section_t->m_args[dim - 1].m_left; ASR::expr_t* end = array_section_t->m_args[dim - 1].m_right; ASR::expr_t* d = array_section_t->m_args[dim - 1].m_step; + start = CastingUtil::perform_casting(start, a_type, al, a_loc); + end = CastingUtil::perform_casting(end, a_type, al, a_loc); + d = CastingUtil::perform_casting(d, a_type, al, a_loc); ASR::expr_t* endminusstart = ASRUtils::EXPR(ASR::make_IntegerBinOp_t( al, a_loc, end, ASR::binopType::Sub, start, a_type, nullptr)); ASR::expr_t* byd = ASRUtils::EXPR(ASR::make_IntegerBinOp_t( @@ -2326,7 +2546,9 @@ static inline ASR::ttype_t* duplicate_type(Allocator& al, const ASR::ttype_t* t, ASR::ttype_t* dup_type = duplicate_type(al, ptr->m_type, dims, physical_type, override_physical_type); if( override_physical_type && - physical_type == ASR::array_physical_typeType::FixedSizeArray ) { + (physical_type == ASR::array_physical_typeType::FixedSizeArray || + (physical_type == ASR::array_physical_typeType::CharacterArraySinglePointer && + dims != nullptr) ) ) { return dup_type; } return ASRUtils::TYPE(ASR::make_Pointer_t(al, ptr->base.base.loc, @@ -2387,6 +2609,9 @@ static inline ASR::ttype_t* duplicate_type(Allocator& al, const ASR::ttype_t* t, ft->m_static, ft->m_restrictions, ft->n_restrictions, ft->m_is_restriction)); } + case ASR::ttypeType::SymbolicExpression: { + return ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, t->base.loc)); + } default : throw LCompilersException("Not implemented " + std::to_string(t->type)); } LCOMPILERS_ASSERT(t_ != nullptr); @@ -2398,9 +2623,9 @@ static inline ASR::ttype_t* duplicate_type(Allocator& al, const ASR::ttype_t* t, static inline void set_absent_optional_arguments_to_null( Vec& args, ASR::Function_t* func, Allocator& al, - ASR::expr_t* dt=nullptr) { - int offset = (dt != nullptr); - for( size_t i = args.size(); i < func->n_args - offset; i++ ) { + ASR::expr_t* dt=nullptr, bool nopass = false) { + int offset = (dt != nullptr) && (!nopass); + for( size_t i = args.size(); i + offset < func->n_args; i++ ) { if( ASR::is_a( *ASR::down_cast(func->m_args[i + offset])->m_v) ) { LCOMPILERS_ASSERT(ASRUtils::EXPR2VAR(func->m_args[i + offset])->m_presence == @@ -2413,7 +2638,7 @@ static inline void set_absent_optional_arguments_to_null( args.push_back(al, empty_arg); } } - LCOMPILERS_ASSERT(args.size() == (func->n_args - offset)); + LCOMPILERS_ASSERT(args.size() + offset == (func->n_args)); } static inline ASR::ttype_t* duplicate_type_with_empty_dims(Allocator& al, ASR::ttype_t* t, @@ -2537,15 +2762,12 @@ inline int extract_kind_str(char* m_n, char *&kind_str) { return 4; } +// this function only extract's the 'kind' and raises an error when it's of +// inappropriate type (e.g. float), but doesn't ensure 'kind' is appropriate +// for whose kind it is template inline int extract_kind(ASR::expr_t* kind_expr, const Location& loc) { - int a_kind = 4; switch( kind_expr->type ) { - case ASR::exprType::IntegerConstant: { - a_kind = ASR::down_cast - (kind_expr)->m_n; - break; - } case ASR::exprType::Var: { ASR::Var_t* kind_var = ASR::down_cast(kind_expr); @@ -2559,29 +2781,64 @@ inline int extract_kind(ASR::expr_t* kind_expr, const Location& loc) { is_parent_enum = ASR::is_a(*s); } if( is_parent_enum ) { - a_kind = ASRUtils::extract_kind_from_ttype_t(kind_variable->m_type); + return ASRUtils::extract_kind_from_ttype_t(kind_variable->m_type); } else if( kind_variable->m_storage == ASR::storage_typeType::Parameter ) { if( kind_variable->m_type->type == ASR::ttypeType::Integer ) { LCOMPILERS_ASSERT( kind_variable->m_value != nullptr ); - a_kind = ASR::down_cast(kind_variable->m_value)->m_n; + return ASR::down_cast(kind_variable->m_value)->m_n; } 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"; + 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; } + case ASR::exprType::IntrinsicElementalFunction: { + ASR::IntrinsicElementalFunction_t* kind_isf = + ASR::down_cast(kind_expr); + if (kind_isf->m_intrinsic_id == 1 && kind_isf->m_value) { + // m_intrinsic_id: 1 -> kind intrinsic + LCOMPILERS_ASSERT( ASR::is_a(*kind_isf->m_value) ); + ASR::IntegerConstant_t* kind_ic = + ASR::down_cast(kind_isf->m_value); + return kind_ic->m_n; + } else { + throw SemanticError("Only Integer literals or expressions which " + "reduce to constant Integer are accepted as kind parameters.", + loc); + } + } + // allow integer binary operator kinds (e.g. '1 + 7') + case ASR::exprType::IntegerBinOp: + // allow integer kinds (e.g. 4, 8 etc.) + case ASR::exprType::IntegerConstant: { + int a_kind = -1; + if (!ASRUtils::extract_value(kind_expr, a_kind)) { + // we still need to ensure that values are constant + // e.g. "integer :: a = 4; real(1*a) :: x" is an invalid kind, + // as 'a' isn't a constant. + // ToDo: we should raise a better error, by "locating" just + // 'a' as well, instead of the whole '1*a' + throw SemanticError("Only Integer literals or expressions which " + "reduce to constant Integer are accepted as kind parameters.", + loc); + } + return a_kind; + } + // make sure not to allow kind having "RealConstant" (e.g. 4.0), + // and everything else default: { - throw SemanticError(R"""(Only Integer literals or expressions which reduce to constant Integer are accepted as kind parameters.)""", - loc); + throw SemanticError( + "Only Integer literals or expressions which " + "reduce to constant Integer are accepted as kind parameters.", + loc + ); } } - return a_kind; } template @@ -2609,7 +2866,7 @@ inline int extract_len(ASR::expr_t* len_expr, const Location& loc) { throw SemanticError(msg, loc); } } else { - // An expression is beind used for `len` that cannot be evaluated + // An expression is being used for `len` that cannot be evaluated a_len = -3; } break; @@ -2619,12 +2876,17 @@ inline int extract_len(ASR::expr_t* len_expr, const Location& loc) { a_len = -3; break; } + case ASR::exprType::ArraySize: case ASR::exprType::IntegerBinOp: { a_len = -3; break; } + case ASR::exprType::IntrinsicElementalFunction: { + a_len = -3; + break; + } default: { - throw SemanticError("Only Integers or variables implemented so far for `len` expressions", + throw SemanticError("Only Integers or variables implemented so far for `len` expressions, found: " + std::to_string(len_expr->type), loc); } } @@ -2723,25 +2985,37 @@ inline bool expr_equal(ASR::expr_t* x, ASR::expr_t* y) { return true; } -inline bool dimension_expr_equal(ASR::expr_t* dim_a, ASR::expr_t* dim_b) { - if( !(dim_a && dim_b) ) { +// Compares two dimension expressions for equality. +// Optionally allows skipping determination in certain cases. +inline bool dimension_expr_equal( + ASR::expr_t* dim_a, + ASR::expr_t* dim_b +) { + // If either dimension is null, consider them equal by default. + if (!(dim_a && dim_b)) { return true; } - int dim_a_int = -1, dim_b_int = -1; - if (ASRUtils::extract_value(ASRUtils::expr_value(dim_a), dim_a_int) - && ASRUtils::extract_value(ASRUtils::expr_value(dim_b), dim_b_int)) { + + int dim_a_int {-1}; + int dim_b_int {-1}; + + if (ASRUtils::extract_value(ASRUtils::expr_value(dim_a), dim_a_int) && + ASRUtils::extract_value(ASRUtils::expr_value(dim_b), dim_b_int)) { return dim_a_int == dim_b_int; } - if( !ASRUtils::expr_equal(dim_a, dim_b) ) { + if (!ASRUtils::expr_equal(dim_a, dim_b)) { return false; } + return true; } inline bool dimensions_equal(ASR::dimension_t* dims_a, size_t n_dims_a, - ASR::dimension_t* dims_b, size_t n_dims_b) { - if( n_dims_a != n_dims_b ) { + ASR::dimension_t* dims_b, size_t n_dims_b +) { + // unequal ranks means dimensions aren't equal + if (n_dims_a != n_dims_b) { return false; } @@ -2761,6 +3035,9 @@ inline bool types_equal(ASR::ttype_t *a, ASR::ttype_t *b, // TODO: If anyone of the input or argument is derived type then // add support for checking member wise types and do not compare // directly. From stdlib_string len(pattern) error + if( a == nullptr && b == nullptr ) { + return true; + } a = ASRUtils::type_get_past_const( ASRUtils::type_get_past_allocatable( ASRUtils::type_get_past_pointer(a))); @@ -2875,6 +3152,207 @@ inline bool types_equal(ASR::ttype_t *a, ASR::ttype_t *b, b2->m_union_type)); return a2_type == b2_type; } + case ASR::ttypeType::FunctionType: { + ASR::FunctionType_t* a2 = ASR::down_cast(a); + ASR::FunctionType_t* b2 = ASR::down_cast(b); + if( a2->n_arg_types != b2->n_arg_types || + (a2->m_return_var_type != nullptr && b2->m_return_var_type == nullptr) || + (a2->m_return_var_type == nullptr && b2->m_return_var_type != nullptr) ) { + return false; + } + for( size_t i = 0; i < a2->n_arg_types; i++ ) { + if( !types_equal(a2->m_arg_types[i], b2->m_arg_types[i], true) ) { + return false; + } + } + if( !types_equal(a2->m_return_var_type, b2->m_return_var_type, true) ) { + return false; + } + return true; + } + default : return false; + } + } else if( a->type == ASR::ttypeType::Struct && + b->type == ASR::ttypeType::Class ) { + ASR::Struct_t *a2 = ASR::down_cast(a); + ASR::Class_t *b2 = ASR::down_cast(b); + ASR::symbol_t* a2_typesym = ASRUtils::symbol_get_past_external(a2->m_derived_type); + ASR::symbol_t* b2_typesym = ASRUtils::symbol_get_past_external(b2->m_class_type); + if( a2_typesym->type != b2_typesym->type ) { + return false; + } + if( a2_typesym->type == ASR::symbolType::ClassType ) { + ASR::ClassType_t *a2_type = ASR::down_cast(a2_typesym); + ASR::ClassType_t *b2_type = ASR::down_cast(b2_typesym); + return a2_type == b2_type; + } else if( a2_typesym->type == ASR::symbolType::StructType ) { + ASR::StructType_t *a2_type = ASR::down_cast(a2_typesym); + ASR::StructType_t *b2_type = ASR::down_cast(b2_typesym); + return is_derived_type_similar(a2_type, b2_type); + } + } else if( a->type == ASR::ttypeType::Class && + b->type == ASR::ttypeType::Struct ) { + ASR::Class_t *a2 = ASR::down_cast(a); + ASR::Struct_t *b2 = ASR::down_cast(b); + ASR::symbol_t* a2_typesym = ASRUtils::symbol_get_past_external(a2->m_class_type); + ASR::symbol_t* b2_typesym = ASRUtils::symbol_get_past_external(b2->m_derived_type); + if( a2_typesym->type != b2_typesym->type ) { + return false; + } + if( a2_typesym->type == ASR::symbolType::ClassType ) { + ASR::ClassType_t *a2_type = ASR::down_cast(a2_typesym); + ASR::ClassType_t *b2_type = ASR::down_cast(b2_typesym); + return a2_type == b2_type; + } else if( a2_typesym->type == ASR::symbolType::StructType ) { + ASR::StructType_t *a2_type = ASR::down_cast(a2_typesym); + ASR::StructType_t *b2_type = ASR::down_cast(b2_typesym); + return is_derived_type_similar(a2_type, b2_type); + } + } + return false; +} + +inline bool types_equal_with_substitution(ASR::ttype_t *a, ASR::ttype_t *b, + std::map subs, + bool check_for_dimensions=false) { + // TODO: If anyone of the input or argument is derived type then + // add support for checking member wise types and do not compare + // directly. From stdlib_string len(pattern) error + if( a == nullptr && b == nullptr ) { + return true; + } + 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 ) { + a = ASRUtils::type_get_past_array(a); + b = ASRUtils::type_get_past_array(b); + } + if (ASR::is_a(*a)) { + ASR::TypeParameter_t* a_tp = ASR::down_cast(a); + a = subs[a_tp->m_param]; + } + if (a->type == b->type) { + // TODO: check dims + // TODO: check all types + switch (a->type) { + case (ASR::ttypeType::Array): { + ASR::Array_t* a2 = ASR::down_cast(a); + ASR::Array_t* b2 = ASR::down_cast(b); + if( !types_equal_with_substitution(a2->m_type, b2->m_type, subs) ) { + return false; + } + + return ASRUtils::dimensions_equal( + a2->m_dims, a2->n_dims, + b2->m_dims, b2->n_dims); + } + case (ASR::ttypeType::TypeParameter) : { + ASR::TypeParameter_t* left_tp = ASR::down_cast(a); + ASR::TypeParameter_t* right_tp = ASR::down_cast(b); + std::string left_param = left_tp->m_param; + std::string right_param = right_tp->m_param; + return left_param == right_param; + } + case (ASR::ttypeType::Integer) : { + ASR::Integer_t *a2 = ASR::down_cast(a); + ASR::Integer_t *b2 = ASR::down_cast(b); + return (a2->m_kind == b2->m_kind); + } + case (ASR::ttypeType::UnsignedInteger) : { + ASR::UnsignedInteger_t *a2 = ASR::down_cast(a); + ASR::UnsignedInteger_t *b2 = ASR::down_cast(b); + return (a2->m_kind == b2->m_kind); + } + case ASR::ttypeType::CPtr: { + return true; + } + case ASR::ttypeType::SymbolicExpression: { + return true; + } + case (ASR::ttypeType::Real) : { + ASR::Real_t *a2 = ASR::down_cast(a); + ASR::Real_t *b2 = ASR::down_cast(b); + return (a2->m_kind == b2->m_kind); + } + case (ASR::ttypeType::Complex) : { + ASR::Complex_t *a2 = ASR::down_cast(a); + ASR::Complex_t *b2 = ASR::down_cast(b); + return (a2->m_kind == b2->m_kind); + } + case (ASR::ttypeType::Logical) : { + ASR::Logical_t *a2 = ASR::down_cast(a); + ASR::Logical_t *b2 = ASR::down_cast(b); + return (a2->m_kind == b2->m_kind); + } + case (ASR::ttypeType::Character) : { + ASR::Character_t *a2 = ASR::down_cast(a); + ASR::Character_t *b2 = ASR::down_cast(b); + return (a2->m_kind == b2->m_kind); + } + case (ASR::ttypeType::List) : { + ASR::List_t *a2 = ASR::down_cast(a); + ASR::List_t *b2 = ASR::down_cast(b); + return types_equal_with_substitution(a2->m_type, b2->m_type, subs); + } + case (ASR::ttypeType::Struct) : { + ASR::Struct_t *a2 = ASR::down_cast(a); + ASR::Struct_t *b2 = ASR::down_cast(b); + ASR::StructType_t *a2_type = ASR::down_cast( + ASRUtils::symbol_get_past_external( + a2->m_derived_type)); + ASR::StructType_t *b2_type = ASR::down_cast( + ASRUtils::symbol_get_past_external( + b2->m_derived_type)); + return a2_type == b2_type; + } + case (ASR::ttypeType::Class) : { + ASR::Class_t *a2 = ASR::down_cast(a); + ASR::Class_t *b2 = ASR::down_cast(b); + ASR::symbol_t* a2_typesym = ASRUtils::symbol_get_past_external(a2->m_class_type); + ASR::symbol_t* b2_typesym = ASRUtils::symbol_get_past_external(b2->m_class_type); + if( a2_typesym->type != b2_typesym->type ) { + return false; + } + if( a2_typesym->type == ASR::symbolType::ClassType ) { + ASR::ClassType_t *a2_type = ASR::down_cast(a2_typesym); + ASR::ClassType_t *b2_type = ASR::down_cast(b2_typesym); + return a2_type == b2_type; + } else if( a2_typesym->type == ASR::symbolType::StructType ) { + ASR::StructType_t *a2_type = ASR::down_cast(a2_typesym); + ASR::StructType_t *b2_type = ASR::down_cast(b2_typesym); + return is_derived_type_similar(a2_type, b2_type); + } + return false; + } + case (ASR::ttypeType::Union) : { + ASR::Union_t *a2 = ASR::down_cast(a); + ASR::Union_t *b2 = ASR::down_cast(b); + ASR::UnionType_t *a2_type = ASR::down_cast( + ASRUtils::symbol_get_past_external( + a2->m_union_type)); + ASR::UnionType_t *b2_type = ASR::down_cast( + ASRUtils::symbol_get_past_external( + b2->m_union_type)); + return a2_type == b2_type; + } + case ASR::ttypeType::FunctionType: { + ASR::FunctionType_t* a2 = ASR::down_cast(a); + ASR::FunctionType_t* b2 = ASR::down_cast(b); + if( a2->n_arg_types != b2->n_arg_types || + (a2->m_return_var_type != nullptr && b2->m_return_var_type == nullptr) || + (a2->m_return_var_type == nullptr && b2->m_return_var_type != nullptr) ) { + return false; + } + for( size_t i = 0; i < a2->n_arg_types; i++ ) { + if( !types_equal_with_substitution(a2->m_arg_types[i], b2->m_arg_types[i], subs, true) ) { + return false; + } + } + if( !types_equal_with_substitution(a2->m_return_var_type, b2->m_return_var_type, subs, true) ) { + return false; + } + return true; + } default : return false; } } else if( a->type == ASR::ttypeType::Struct && @@ -3016,10 +3494,33 @@ inline bool check_equal_type(ASR::ttype_t* x, ASR::ttype_t* y, bool check_for_di return types_equal(x, y, check_for_dimensions); } +bool select_func_subrout(const ASR::symbol_t* proc, const Vec& args, + Location& loc, const std::function err); + +template int select_generic_procedure(const Vec &args, - const ASR::GenericProcedure_t &p, Location loc, - const std::function err, - bool raise_error=true); + const T &p, Location loc, + const std::function err, + bool raise_error=true) { + for (size_t i=0; i < p.n_procs; i++) { + if( ASR::is_a(*p.m_procs[i]) ) { + ASR::ClassProcedure_t *clss_fn + = ASR::down_cast(p.m_procs[i]); + const ASR::symbol_t *proc = ASRUtils::symbol_get_past_external(clss_fn->m_proc); + if( select_func_subrout(proc, args, loc, err) ) { + return i; + } + } else { + if( select_func_subrout(p.m_procs[i], args, loc, err) ) { + return i; + } + } + } + if( raise_error ) { + err("Arguments do not match for any generic procedure, " + std::string(p.m_name), loc); + } + return -1; +} ASR::asr_t* symbol_resolve_external_generic_procedure_without_eval( const Location &loc, @@ -3254,65 +3755,76 @@ class ReplaceArgVisitor: public ASR::BaseExprReplacer { f = ASR::down_cast(f_sym); } } - ASR::Module_t *m = ASR::down_cast2(f->m_symtab->parent->asr_owner); - char *modname = m->m_name; - ASR::symbol_t *maybe_f = current_scope->resolve_symbol(std::string(f->m_name)); - ASR::symbol_t* maybe_f_actual = nullptr; - std::string maybe_modname = ""; - if( maybe_f && ASR::is_a(*maybe_f) ) { - maybe_modname = ASR::down_cast(maybe_f)->m_module_name; - maybe_f_actual = ASRUtils::symbol_get_past_external(maybe_f); - } - // If the Function to be imported is already present - // then do not import. - if( maybe_modname == std::string(modname) && - f_sym == maybe_f_actual ) { - new_es = maybe_f; - } else { - // Import while assigning a new name to avoid conflicts - // For example, if someone is using `len` from a user - // define module then `get_unique_name` will avoid conflict - std::string unique_name = current_scope->get_unique_name(f->m_name, false); - Str s; s.from_str_view(unique_name); - char *unique_name_c = s.c_str(al); - LCOMPILERS_ASSERT(current_scope->get_symbol(unique_name) == nullptr); - new_es = ASR::down_cast(ASR::make_ExternalSymbol_t( - al, f->base.base.loc, - /* a_symtab */ current_scope, - /* a_name */ unique_name_c, - (ASR::symbol_t*)f, - modname, nullptr, 0, - f->m_name, - ASR::accessType::Private - )); - current_scope->add_symbol(unique_name, new_es); - } - // The following substitutes args from the current scope - for (size_t i = 0; i < x->n_args; i++) { - ASR::expr_t** current_expr_copy_ = current_expr; - current_expr = &(x->m_args[i].m_value); - replace_expr(x->m_args[i].m_value); - current_expr = current_expr_copy_; - } - switch( x->m_type->type ) { - case ASR::ttypeType::Character: { - ASR::Character_t* char_type = ASR::down_cast(x->m_type); - if( char_type->m_len_expr ) { + ASR::Module_t *m = nullptr; + if (ASR::is_a(*f->m_symtab->parent->asr_owner)) { + ASR::symbol_t* sym = ASR::down_cast(f->m_symtab->parent->asr_owner); + if (ASR::is_a(*sym)) { + m = ASR::down_cast(sym); + char *modname = m->m_name; + ASR::symbol_t *maybe_f = current_scope->resolve_symbol(std::string(f->m_name)); + ASR::symbol_t* maybe_f_actual = nullptr; + std::string maybe_modname = ""; + if( maybe_f && ASR::is_a(*maybe_f) ) { + maybe_modname = ASR::down_cast(maybe_f)->m_module_name; + maybe_f_actual = ASRUtils::symbol_get_past_external(maybe_f); + } + // If the Function to be imported is already present + // then do not import. + if( maybe_modname == std::string(modname) && + f_sym == maybe_f_actual ) { + new_es = maybe_f; + } else { + // Import while assigning a new name to avoid conflicts + // For example, if someone is using `len` from a user + // define module then `get_unique_name` will avoid conflict + std::string unique_name = current_scope->get_unique_name(f->m_name, false); + Str s; s.from_str_view(unique_name); + char *unique_name_c = s.c_str(al); + LCOMPILERS_ASSERT(current_scope->get_symbol(unique_name) == nullptr); + new_es = ASR::down_cast(ASR::make_ExternalSymbol_t( + al, f->base.base.loc, + /* a_symtab */ current_scope, + /* a_name */ unique_name_c, + (ASR::symbol_t*)f, + modname, nullptr, 0, + f->m_name, + ASR::accessType::Private + )); + current_scope->add_symbol(unique_name, new_es); + } + // The following substitutes args from the current scope + for (size_t i = 0; i < x->n_args; i++) { ASR::expr_t** current_expr_copy_ = current_expr; - current_expr = &(char_type->m_len_expr); - replace_expr(char_type->m_len_expr); + current_expr = &(x->m_args[i].m_value); + replace_expr(x->m_args[i].m_value); current_expr = current_expr_copy_; } - break; + replace_ttype(x->m_type); + if (ASRUtils::symbol_parent_symtab(new_es)->get_counter() != current_scope->get_counter()) { + ADD_ASR_DEPENDENCIES(current_scope, new_es, current_function_dependencies); + } + ASRUtils::insert_module_dependency(new_es, al, current_module_dependencies); + x->m_name = new_es; + if( x->m_original_name ) { + ASR::symbol_t* x_original_name = current_scope->resolve_symbol(ASRUtils::symbol_name(x->m_original_name)); + if( x_original_name ) { + x->m_original_name = x_original_name; + } + } + return; + } else { + return; } - default: - break; } - if (ASRUtils::symbol_parent_symtab(new_es)->get_counter() != current_scope->get_counter()) { - ADD_ASR_DEPENDENCIES(current_scope, new_es, current_function_dependencies); + // iterate over the arguments and replace them + for (size_t i = 0; i < x->n_args; i++) { + ASR::expr_t** current_expr_copy_ = current_expr; + current_expr = &(x->m_args[i].m_value); + if (x->m_args[i].m_value) { + replace_expr(x->m_args[i].m_value); + } + current_expr = current_expr_copy_; } - ASRUtils::insert_module_dependency(new_es, al, current_module_dependencies); - x->m_name = new_es; } void replace_Var(ASR::Var_t* x) { @@ -3365,6 +3877,49 @@ class ExprStmtDuplicator: public ASR::BaseExprStmtDuplicator }; +class FixScopedTypeVisitor: public ASR::BaseExprReplacer { + + private: + + Allocator& al; + SymbolTable* current_scope; + + public: + + FixScopedTypeVisitor(Allocator& al_, SymbolTable* current_scope_) : + al(al_), current_scope(current_scope_) {} + + void replace_Struct(ASR::Struct_t* x) { + ASR::symbol_t* m_derived_type = current_scope->resolve_symbol( + ASRUtils::symbol_name(x->m_derived_type)); + if (m_derived_type == nullptr) { + std::string imported_name = current_scope->get_unique_name( + ASRUtils::symbol_name(x->m_derived_type)); + m_derived_type = ASR::down_cast(ASR::make_ExternalSymbol_t( + al, x->base.base.loc, current_scope, s2c(al, imported_name), + x->m_derived_type, ASRUtils::get_sym_module( + ASRUtils::symbol_get_past_external(x->m_derived_type))->m_name, + nullptr, 0, ASRUtils::symbol_name( + ASRUtils::symbol_get_past_external(x->m_derived_type)), + ASR::accessType::Public)); + current_scope->add_symbol(imported_name, m_derived_type); + } + x->m_derived_type = m_derived_type; + } + +}; + +static inline ASR::ttype_t* fix_scoped_type(Allocator& al, + ASR::ttype_t* type, SymbolTable* scope) { + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(type); + ASRUtils::FixScopedTypeVisitor fixer(al, scope); + fixer.replace_ttype(type_); + return type_; + +} + class ReplaceWithFunctionParamVisitor: public ASR::BaseExprReplacer { private: @@ -4095,25 +4650,6 @@ static inline ASR::expr_t* get_size(ASR::expr_t* arr_expr, Allocator& al) { return ASRUtils::EXPR(ASRUtils::make_ArraySize_t_util(al, arr_expr->base.loc, arr_expr, nullptr, int32_type, nullptr)); } -static inline void get_dimensions(ASR::expr_t* array, Vec& dims, - Allocator& al) { - ASR::ttype_t* array_type = ASRUtils::expr_type(array); - ASR::dimension_t* compile_time_dims = nullptr; - int n_dims = extract_dimensions_from_ttype(array_type, compile_time_dims); - for( int i = 0; i < n_dims; i++ ) { - ASR::expr_t* start = compile_time_dims[i].m_start; - if( start == nullptr ) { - start = get_bound(array, i + 1, "lbound", al); - } - ASR::expr_t* length = compile_time_dims[i].m_length; - if( length == nullptr ) { - length = get_size(array, i + 1, al); - } - dims.push_back(al, start); - dims.push_back(al, length); - } -} - static inline ASR::EnumType_t* get_EnumType_from_symbol(ASR::symbol_t* s) { ASR::Variable_t* s_var = ASR::down_cast(s); if( ASR::is_a(*s_var->m_type) ) { @@ -4255,6 +4791,44 @@ static inline int KMP_string_match(std::string &s_var, std::string &sub) { return res; } +static inline int KMP_string_match_count(std::string &s_var, std::string &sub) { + int str_len = s_var.size(); + int sub_len = sub.size(); + int count = 0; + std::vector lps(sub_len, 0); + if (sub_len == 0) { + count = str_len + 1; + } else { + for(int i = 1, len = 0; i < sub_len;) { + if (sub[i] == sub[len]) { + lps[i++] = ++len; + } else { + if (len != 0) { + len = lps[len - 1]; + } else { + lps[i++] = 0; + } + } + } + for (int i = 0, j = 0; (str_len - i) >= (sub_len - j);) { + if (sub[j] == s_var[i]) { + j++, i++; + } + if (j == sub_len) { + count++; + j = lps[j - 1]; + } else if (i < str_len && sub[j] != s_var[i]) { + if (j != 0) { + j = lps[j - 1]; + } else { + i = i + 1; + } + } + } + } + return count; +} + static inline void visit_expr_list(Allocator &al, Vec& exprs, Vec& exprs_vec) { LCOMPILERS_ASSERT(exprs_vec.reserve_called); @@ -4279,7 +4853,7 @@ class VerifyAbort {}; static inline void require_impl(bool cond, const std::string &error_msg, const Location &loc, diag::Diagnostics &diagnostics) { if (!cond) { - diagnostics.message_label("ASR verify: " + error_msg, + diagnostics.message_label(error_msg, {loc}, "failed here", diag::Level::Error, diag::Stage::ASRVerify); throw VerifyAbort(); @@ -4398,7 +4972,21 @@ static inline ASR::asr_t* make_ArrayPhysicalCast_t_util(Allocator &al, const Loc return ASR::make_ArrayPhysicalCast_t(al, a_loc, a_arg, a_old, a_new, a_type, a_value); } -inline ASR::asr_t* make_ArrayConstant_t_util(Allocator &al, const Location &a_loc, +inline void flatten_ArrayConstant(Allocator& al, ASR::expr_t** a_args, size_t n_args, Vec &new_args) { + for (size_t i = 0; i < n_args; i++) { + if (ASR::is_a(*a_args[i])) { + ASR::ArrayConstant_t* a_arg = ASR::down_cast(a_args[i]); + flatten_ArrayConstant(al, a_arg->m_args, a_arg->n_args, new_args); + } else if (ASR::is_a(*ASRUtils::expr_value(a_args[i]))) { + ASR::ArrayConstant_t* a_arg = ASR::down_cast(ASRUtils::expr_value(a_args[i])); + flatten_ArrayConstant(al, a_arg->m_args, a_arg->n_args, new_args); + } else { + new_args.push_back(al, ASRUtils::expr_value(a_args[i])); + } + } +} + +inline ASR::asr_t* make_ArrayConstructor_t_util(Allocator &al, const Location &a_loc, ASR::expr_t** a_args, size_t n_args, ASR::ttype_t* a_type, ASR::arraystorageType a_storage_format) { if( !ASRUtils::is_array(a_type) ) { Vec dims; @@ -4422,31 +5010,43 @@ inline ASR::asr_t* make_ArrayConstant_t_util(Allocator &al, const Location &a_lo } LCOMPILERS_ASSERT(ASRUtils::is_array(a_type)); - return ASR::make_ArrayConstant_t(al, a_loc, a_args, n_args, a_type, a_storage_format); + bool all_expr_evaluated = n_args > 0; + for (size_t i = 0; i < n_args; i++) { + ASR::expr_t* a_value = ASRUtils::expr_value(a_args[i]); + if (!is_value_constant(a_value)) { + all_expr_evaluated = false; + } + } + if (all_expr_evaluated) { + Vec a_args_values; a_args_values.reserve(al, n_args); + flatten_ArrayConstant(al, a_args, n_args, a_args_values); + ASR::Array_t* a_type_ = ASR::down_cast(a_type); + Vec dims; dims.reserve(al, 1); + ASR::dimension_t dim; dim.loc = a_type_->m_dims[0].loc; dim.m_start = a_type_->m_dims[0].m_start; + dim.m_length = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, a_type_->m_dims[0].m_length->base.loc, + a_args_values.n, + ASRUtils::TYPE(ASR::make_Integer_t(al, a_loc, 4)))); + dims.push_back(al, dim); + ASR::ttype_t* new_type = ASRUtils::TYPE(ASR::make_Array_t(al, a_type->base.loc, a_type_->m_type, + dims.p, dims.n, a_type_->m_physical_type)); + return ASR::make_ArrayConstant_t(al, a_loc, a_args_values.p, a_args_values.n, new_type, a_storage_format); + } else { + return ASR::make_ArrayConstructor_t(al, a_loc, a_args, n_args, a_type, nullptr, a_storage_format); + } } void make_ArrayBroadcast_t_util(Allocator& al, const Location& loc, ASR::expr_t*& expr1, ASR::expr_t*& expr2); static inline void Call_t_body(Allocator& al, ASR::symbol_t* a_name, - ASR::call_arg_t* a_args, size_t n_args, ASR::expr_t* a_dt, ASR::stmt_t** cast_stmt, bool implicit_argument_casting) { - bool is_method = a_dt != nullptr; + ASR::call_arg_t* a_args, size_t n_args, ASR::expr_t* a_dt, ASR::stmt_t** cast_stmt, + bool implicit_argument_casting, bool nopass) { + bool is_method = (a_dt != nullptr) && (!nopass); ASR::symbol_t* a_name_ = ASRUtils::symbol_get_past_external(a_name); - ASR::FunctionType_t* func_type = nullptr; - if( ASR::is_a(*a_name_) ) { - func_type = ASR::down_cast( - ASR::down_cast(a_name_)->m_function_signature); - } else if( ASR::is_a(*a_name_) ) { - func_type = ASR::down_cast( - ASR::down_cast(a_name_)->m_type); - } else if( ASR::is_a(*a_name_) ) { - ASR::Function_t* func = ASR::down_cast( - ASRUtils::symbol_get_past_external( - ASR::down_cast(a_name_)->m_proc)); - func_type = ASR::down_cast(func->m_function_signature); - } else { - LCOMPILERS_ASSERT(false); + if( ASR::is_a(*a_name_) ) { + is_method = false; } + ASR::FunctionType_t* func_type = get_FunctionType(a_name); for( size_t i = 0; i < n_args; i++ ) { if( a_args[i].m_value == nullptr || @@ -4539,7 +5139,7 @@ static inline void Call_t_body(Allocator& al, ASR::symbol_t* a_name, dim.push_back(al, dim_); ASR::ttype_t* array_type = ASRUtils::TYPE(ASR::make_Array_t(al, arg->base.loc, int32_type, dim.p, dim.size(), ASR::array_physical_typeType::FixedSizeArray)); - ASR::asr_t* array_constant = ASRUtils::make_ArrayConstant_t_util(al, arg->base.loc, args_.p, args_.size(), array_type, ASR::arraystorageType::ColMajor); + ASR::asr_t* array_constant = ASRUtils::make_ArrayConstructor_t_util(al, arg->base.loc, args_.p, args_.size(), array_type, ASR::arraystorageType::ColMajor); ASR::asr_t* cptr_to_pointer = ASR::make_CPtrToPointer_t(al, arg->base.loc, ASRUtils::EXPR(pointer_to_cptr), cast_expr, ASRUtils::EXPR(array_constant), nullptr); *cast_stmt = ASRUtils::STMT(cptr_to_pointer); @@ -4570,7 +5170,7 @@ static inline void Call_t_body(Allocator& al, ASR::symbol_t* a_name, /*TODO: Remove this if check once intrinsic procedures are implemented correctly*/ LCOMPILERS_ASSERT_MSG( ASRUtils::check_equal_type(arg_type, orig_arg_type), "ASRUtils::check_equal_type(" + ASRUtils::get_type_code(arg_type) + ", " + - ASRUtils::get_type_code(orig_arg_type) + ") in a call to " + ASRUtils::symbol_name(a_name)); + ASRUtils::get_type_code(orig_arg_type) + ")"); } } if( ASRUtils::is_array(arg_type) && ASRUtils::is_array(orig_arg_type) ) { @@ -4607,7 +5207,7 @@ static inline ASR::asr_t* make_FunctionCall_t_util( ASR::symbol_t* a_original_name, ASR::call_arg_t* a_args, size_t n_args, ASR::ttype_t* a_type, ASR::expr_t* a_value, ASR::expr_t* a_dt) { - Call_t_body(al, a_name, a_args, n_args, a_dt, nullptr, false); + Call_t_body(al, a_name, a_args, n_args, a_dt, nullptr, false, false); return ASR::make_FunctionCall_t(al, a_loc, a_name, a_original_name, a_args, n_args, a_type, a_value, a_dt); @@ -4616,12 +5216,39 @@ static inline ASR::asr_t* make_FunctionCall_t_util( static inline ASR::asr_t* make_SubroutineCall_t_util( Allocator &al, const Location &a_loc, ASR::symbol_t* a_name, ASR::symbol_t* a_original_name, ASR::call_arg_t* a_args, size_t n_args, - ASR::expr_t* a_dt, ASR::stmt_t** cast_stmt, bool implicit_argument_casting) { + ASR::expr_t* a_dt, ASR::stmt_t** cast_stmt, bool implicit_argument_casting, bool nopass) { - Call_t_body(al, a_name, a_args, n_args, a_dt, cast_stmt, implicit_argument_casting); + Call_t_body(al, a_name, a_args, n_args, a_dt, cast_stmt, implicit_argument_casting, nopass); + + if( a_dt && ASR::is_a( + *ASRUtils::symbol_get_past_external(a_name)) && + ASR::is_a(*ASRUtils::symbol_type(a_name)) ) { + a_dt = ASRUtils::EXPR(ASR::make_StructInstanceMember_t(al, a_loc, + a_dt, a_name, ASRUtils::symbol_type(a_name), nullptr)); + } - return ASR::make_SubroutineCall_t(al, a_loc, a_name, a_original_name, - a_args, n_args, a_dt); + return ASR::make_SubroutineCall_t(al, a_loc, a_name, a_original_name, a_args, n_args, a_dt); +} + +static inline void promote_ints_to_kind_8(ASR::expr_t** m_args, size_t n_args, + Allocator& al, const Location& loc) { + for (size_t i = 0; i < n_args; i++) { + if (ASRUtils::is_integer(*ASRUtils::expr_type(m_args[i]))) { + ASR::ttype_t* arg_type = ASRUtils::expr_type(m_args[i]); + ASR::ttype_t* dest_type = ASRUtils::duplicate_type(al, arg_type); + ASRUtils::set_kind_to_ttype_t(dest_type, 8); + m_args[i] = CastingUtil::perform_casting(m_args[i], dest_type, al, loc); + } + } +} + +static inline ASR::asr_t* make_StringFormat_t_util(Allocator &al, const Location &a_loc, + ASR::expr_t* a_fmt, ASR::expr_t** a_args, size_t n_args, ASR::string_format_kindType a_kind, + ASR::ttype_t* a_type, ASR::expr_t* a_value) { + + promote_ints_to_kind_8(a_args, n_args, al, a_loc); + + return ASR::make_StringFormat_t(al, a_loc, a_fmt, a_args, n_args, a_kind, a_type, a_value); } static inline ASR::expr_t* cast_to_descriptor(Allocator& al, ASR::expr_t* arg) { @@ -4640,7 +5267,7 @@ static inline ASR::expr_t* cast_to_descriptor(Allocator& al, ASR::expr_t* arg) { return arg; } -static inline ASR::asr_t* make_IntrinsicScalarFunction_t_util( +static inline ASR::asr_t* make_IntrinsicElementalFunction_t_util( Allocator &al, const Location &a_loc, int64_t a_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) { @@ -4659,7 +5286,7 @@ static inline ASR::asr_t* make_IntrinsicScalarFunction_t_util( } } - return ASR::make_IntrinsicScalarFunction_t(al, a_loc, a_intrinsic_id, + return ASR::make_IntrinsicElementalFunction_t(al, a_loc, a_intrinsic_id, a_args, n_args, a_overload_id, a_type, a_value); } @@ -4742,7 +5369,36 @@ inline ASR::ttype_t* make_Pointer_t_util(Allocator& al, const Location& loc, ASR return ASRUtils::TYPE(ASR::make_Pointer_t(al, loc, type)); } -int64_t compute_trailing_zeros(int64_t number); +int64_t compute_trailing_zeros(int64_t number, int64_t kind); +int64_t compute_leading_zeros(int64_t number, int64_t kind); +void append_error(diag::Diagnostics& diag, const std::string& msg, + const Location& loc); + +static inline bool is_simd_array(ASR::expr_t *v) { + return (ASR::is_a(*expr_type(v)) && + ASR::down_cast(expr_type(v))->m_physical_type + == ASR::array_physical_typeType::SIMDArray); +} + +static inline bool is_argument_of_type_CPtr(ASR::expr_t *var) { + bool is_argument = false; + if (ASR::is_a(*expr_type(var))) { + if (ASR::is_a(*var)) { + ASR::symbol_t *var_sym = ASR::down_cast(var)->m_v; + if (ASR::is_a(*var_sym)) { + ASR::Variable_t *v = ASR::down_cast(var_sym); + if (v->m_intent == intent_local || + v->m_intent == intent_return_var || + !v->m_intent) { + is_argument = false; + } else { + is_argument = true; + } + } + } + } + return is_argument; +} } // namespace ASRUtils diff --git a/src/libasr/asr_verify.cpp b/src/libasr/asr_verify.cpp index 9bea5dc..a081f93 100644 --- a/src/libasr/asr_verify.cpp +++ b/src/libasr/asr_verify.cpp @@ -51,6 +51,8 @@ class VerifyVisitor : public BaseWalkVisitor std::set> const_assigned; bool symbol_visited; + bool _return_var_or_intent_out = false; + bool _processing_dims = false; public: VerifyVisitor(bool check_external, diag::Diagnostics &diagnostics) : check_external{check_external}, @@ -438,6 +440,7 @@ class VerifyVisitor : public BaseWalkVisitor LCOMPILERS_ASSERT(a.second); this->visit_symbol(*a.second); } + visit_ttype(*x.m_function_signature); for (size_t i=0; i visit_expr(*x.m_symbolic_value); if (x.m_value) visit_expr(*x.m_value); + _return_var_or_intent_out = x.m_intent == ASR::intentType::Out || + x.m_intent == ASR::intentType::InOut || + x.m_intent == ASR::intentType::ReturnVar; visit_ttype(*x.m_type); + _return_var_or_intent_out = false; verify_unique_dependencies(x.m_dependencies, x.n_dependencies, x.m_name, x.base.base.loc); @@ -931,6 +938,12 @@ class VerifyVisitor : public BaseWalkVisitor verify_args(x); } + void visit_AssociateBlockCall(const AssociateBlockCall_t &x) { + require(symtab_in_scope(current_symtab, x.m_m), + "AssociateBlockCall::m_name '" + std::string(symbol_name(x.m_m)) + + "' cannot point outside of its symbol table"); + } + SymbolTable *get_dt_symtab(ASR::symbol_t *dt) { LCOMPILERS_ASSERT(dt) SymbolTable *symtab = ASRUtils::symbol_symtab(ASRUtils::symbol_get_past_external(dt)); @@ -1026,16 +1039,16 @@ class VerifyVisitor : public BaseWalkVisitor } } - void visit_IntrinsicScalarFunction(const ASR::IntrinsicScalarFunction_t& x) { + void visit_IntrinsicElementalFunction(const ASR::IntrinsicElementalFunction_t& x) { if( !check_external ) { - BaseWalkVisitor::visit_IntrinsicScalarFunction(x); + BaseWalkVisitor::visit_IntrinsicElementalFunction(x); return ; } - ASRUtils::verify_function verify_ = ASRUtils::IntrinsicScalarFunctionRegistry + ASRUtils::verify_function verify_ = ASRUtils::IntrinsicElementalFunctionRegistry ::get_verify_function(x.m_intrinsic_id); LCOMPILERS_ASSERT(verify_ != nullptr); verify_(x, diagnostics); - BaseWalkVisitor::visit_IntrinsicScalarFunction(x); + BaseWalkVisitor::visit_IntrinsicElementalFunction(x); } void visit_IntrinsicArrayFunction(const ASR::IntrinsicArrayFunction_t& x) { @@ -1071,6 +1084,11 @@ class VerifyVisitor : public BaseWalkVisitor function_dependencies.push_back(std::string(ASRUtils::symbol_name(x.m_name))); } } + if (_return_var_or_intent_out && _processing_dims && + temp_scope->get_counter() != ASRUtils::symbol_parent_symtab(x.m_name)->get_counter() && + !ASR::is_a(*x.m_name)) { + function_dependencies.push_back(std::string(ASRUtils::symbol_name(x.m_name))); + } if( ASR::is_a(*x.m_name) ) { ASR::ExternalSymbol_t* x_m_name = ASR::down_cast(x.m_name); @@ -1116,10 +1134,26 @@ class VerifyVisitor : public BaseWalkVisitor symbol_owner); } + void visit_ArrayConstructor(const ArrayConstructor_t& x) { + require(ASRUtils::is_array(x.m_type), + "Type of ArrayConstructor must be an array"); + BaseWalkVisitor::visit_ArrayConstructor(x); + } + void visit_ArrayConstant(const ArrayConstant_t& x) { require(ASRUtils::is_array(x.m_type), "Type of ArrayConstant must be an array"); - BaseWalkVisitor::visit_ArrayConstant(x); + + for (size_t i = 0; i < x.n_args; i++) { + require(!ASR::is_a(*x.m_args[i]), + "ArrayConstant cannot have ArrayConstant as its elements"); + ASR::expr_t* arg_value = ASRUtils::expr_value(x.m_args[i]); + require( + ASRUtils::is_value_constant(arg_value), + "ArrayConstant must have constant values"); + } + + visit_ttype(*x.m_type); } void visit_dimension(const dimension_t &x) { @@ -1144,9 +1178,11 @@ class VerifyVisitor : public BaseWalkVisitor visit_ttype(*x.m_type); require(x.n_dims != 0, "Array type cannot have 0 dimensions.") require(!ASR::is_a(*x.m_type), "Array type cannot be nested.") + _processing_dims = true; for (size_t i = 0; i < x.n_dims; i++) { visit_dimension(x.m_dims[i]); } + _processing_dims = false; } void visit_Pointer(const Pointer_t &x) { diff --git a/src/libasr/casting_utils.cpp b/src/libasr/casting_utils.cpp index ee5d468..44ea0d2 100644 --- a/src/libasr/casting_utils.cpp +++ b/src/libasr/casting_utils.cpp @@ -55,7 +55,7 @@ namespace LCompilers::CastingUtil { int get_src_dest(ASR::expr_t* left_expr, ASR::expr_t* right_expr, ASR::expr_t*& src_expr, ASR::expr_t*& dest_expr, ASR::ttype_t*& src_type, ASR::ttype_t*& dest_type, - bool is_assign, bool allow_int_to_float=false) { + bool is_assign, bool allow_int_to_float) { ASR::ttype_t* left_type = ASRUtils::expr_type(left_expr); ASR::ttype_t* right_type = ASRUtils::expr_type(right_expr); if( ASR::is_a(*left_type) ) { @@ -73,12 +73,11 @@ namespace LCompilers::CastingUtil { if( is_assign ) { if( ASRUtils::is_real(*left_type) && ASRUtils::is_integer(*right_type) && !allow_int_to_float) { - throw SemanticError("Assigning integer to float is not supported", - right_expr->base.loc); + throw LCompilersException("Assigning integer to float is not supported"); } - if ( ASRUtils::is_complex(*left_type) && !ASRUtils::is_complex(*right_type)) { - throw SemanticError("Assigning non-complex to complex is not supported", - right_expr->base.loc); + if ( ASRUtils::is_complex(*left_type) && !ASRUtils::is_complex(*right_type) && + !allow_int_to_float) { + throw LCompilersException("Assigning non-complex to complex is not supported"); } dest_expr = left_expr, dest_type = left_type; src_expr = right_expr, src_type = right_type; @@ -117,9 +116,13 @@ namespace LCompilers::CastingUtil { return casted_expr_signal; } - ASR::expr_t* perform_casting(ASR::expr_t* expr, ASR::ttype_t* src, + ASR::expr_t* perform_casting(ASR::expr_t* expr, ASR::ttype_t* dest, Allocator& al, const Location& loc) { + ASR::ttype_t* src = ASRUtils::expr_type(expr); + if( ASR::is_a(*src) ) { + src = ASRUtils::get_contained_type(src); + } ASR::ttypeType src_type = ASRUtils::extract_type(src)->type; ASR::ttypeType dest_type = ASRUtils::extract_type(dest)->type; ASR::cast_kindType cast_kind; diff --git a/src/libasr/casting_utils.h b/src/libasr/casting_utils.h index e9b8089..695e295 100644 --- a/src/libasr/casting_utils.h +++ b/src/libasr/casting_utils.h @@ -2,6 +2,8 @@ #define LFORTRAN_CASTING_UTILS_H +#include + #include namespace LCompilers::CastingUtil { @@ -11,11 +13,10 @@ namespace LCompilers::CastingUtil { int get_src_dest(ASR::expr_t* left_expr, ASR::expr_t* right_expr, ASR::expr_t*& src_expr, ASR::expr_t*& dest_expr, ASR::ttype_t*& src_type, ASR::ttype_t*& dest_type, - bool is_assign, bool allow_int_to_float); + bool is_assign, bool allow_int_to_float=false); - ASR::expr_t* perform_casting(ASR::expr_t* expr, ASR::ttype_t* src, - ASR::ttype_t* dest, Allocator& al, - const Location& loc); + ASR::expr_t* perform_casting(ASR::expr_t* expr, ASR::ttype_t* dest, + Allocator& al, const Location& loc); } #endif // LFORTRAN_CASTING_UTILS_H diff --git a/src/libasr/codegen/asr_to_c.cpp b/src/libasr/codegen/asr_to_c.cpp index 7db3e2e..8df1f9d 100644 --- a/src/libasr/codegen/asr_to_c.cpp +++ b/src/libasr/codegen/asr_to_c.cpp @@ -117,23 +117,25 @@ class ASRToCVisitor : public BaseCCPPVisitor } sub += indent + std::string(v_m_name) + "->data = " + std::string(v_m_name) + "_data;\n"; sub += indent + std::string(v_m_name) + "->n_dims = " + std::to_string(n_dims) + ";\n"; - for (int i = 0; i < n_dims; i++) { + sub += indent + std::string(v_m_name) + "->offset = " + std::to_string(0) + ";\n"; + std::string stride = "1"; + for (int i = n_dims - 1; i >= 0; i--) { + std::string start = "1", length = "0"; if( m_dims[i].m_start ) { this->visit_expr(*m_dims[i].m_start); - sub += indent + std::string(v_m_name) + - "->dims[" + std::to_string(i) + "].lower_bound = " + src + ";\n"; - } else { - sub += indent + std::string(v_m_name) + - "->dims[" + std::to_string(i) + "].lower_bound = 0" + ";\n"; + start = src; } if( m_dims[i].m_length ) { this->visit_expr(*m_dims[i].m_length); - sub += indent + std::string(v_m_name) + - "->dims[" + std::to_string(i) + "].length = " + src + ";\n"; - } else { - sub += indent + std::string(v_m_name) + - "->dims[" + std::to_string(i) + "].length = 0" + ";\n"; + length = src; } + sub += indent + std::string(v_m_name) + + "->dims[" + std::to_string(i) + "].lower_bound = " + start + ";\n"; + sub += indent + std::string(v_m_name) + + "->dims[" + std::to_string(i) + "].length = " + length + ";\n"; + sub += indent + std::string(v_m_name) + + "->dims[" + std::to_string(i) + "].stride = " + stride + ";\n"; + stride = "(" + stride + "*" + length + ")"; } sub.pop_back(); sub.pop_back(); @@ -281,9 +283,7 @@ class ASRToCVisitor : public BaseCCPPVisitor v_m_type = ASRUtils::type_get_past_array(ASRUtils::type_get_past_allocatable(v_m_type)); if (ASRUtils::is_pointer(v_m_type)) { ASR::ttype_t *t2 = ASR::down_cast(v_m_type)->m_type; - // TODO: const type in the below line should be ideally - // incorporated in the generated c data type. - t2 = ASRUtils::type_get_past_const(ASRUtils::type_get_past_array(t2)); + t2 = ASRUtils::type_get_past_array(t2); if (ASRUtils::is_integer(*t2)) { ASR::Integer_t *t = ASR::down_cast(ASRUtils::type_get_past_array(t2)); std::string type_name = "int" + std::to_string(t->m_kind * 8) + "_t"; @@ -365,10 +365,6 @@ class ASRToCVisitor : public BaseCCPPVisitor std::string dims = convert_dims_c(n_dims, m_dims, v_m_type, is_fixed_size); sub = format_type_c(dims, type_name, v.m_name, use_ref, dummy); } - } else if (ASRUtils::is_character(*t2)) { - bool is_fixed_size = true; - std::string dims = convert_dims_c(n_dims, m_dims, v_m_type, is_fixed_size); - sub = format_type_c(dims, "char *", v.m_name, use_ref, dummy); } else if(ASR::is_a(*t2)) { ASR::Struct_t *t = ASR::down_cast(t2); std::string der_type_name = ASRUtils::symbol_name(t->m_derived_type); @@ -419,11 +415,6 @@ class ASRToCVisitor : public BaseCCPPVisitor headers.insert("complex.h"); convert_variable_decl_util(v, is_array, declare_as_constant, use_ref, dummy, force_declare, force_declare_name, n_dims, m_dims, v_m_type, dims, sub); - } else if (ASR::is_a(*v_m_type)) { - headers.insert("symengine/cwrapper.h"); - std::string type_name = "basic"; - std::string v_m_name = v.m_name; - sub = format_type_c("", type_name, v_m_name, use_ref, dummy); } else if (ASRUtils::is_logical(*v_m_type)) { convert_variable_decl_util(v, is_array, declare_as_constant, use_ref, dummy, force_declare, force_declare_name, n_dims, m_dims, v_m_type, dims, sub); @@ -533,7 +524,11 @@ class ASRToCVisitor : public BaseCCPPVisitor } else if (ASR::is_a(*v_m_type)) { ASR::List_t* t = ASR::down_cast(v_m_type); std::string list_type_c = c_ds_api->get_list_type(t); - sub = format_type_c("", list_type_c, v.m_name, + std::string name = v.m_name; + if (v.m_intent == ASRUtils::intent_out) { + name = "*" + name; + } + sub = format_type_c("", list_type_c, name, false, false); } else if (ASR::is_a(*v_m_type)) { ASR::Tuple_t* t = ASR::down_cast(v_m_type); @@ -1122,21 +1117,25 @@ R"( // Initialise Numpy ASR::dimension_t* m_dims = nullptr; int n_dims = ASRUtils::extract_dimensions_from_ttype(ASRUtils::expr_type(x.m_ptr), m_dims); dim_set_code = indent + dest_src + "->n_dims = " + std::to_string(n_dims) + ";\n"; - for( int i = 0; i < n_dims; i++ ) { + dim_set_code = indent + dest_src + "->offset = 0;\n"; + std::string stride = "1"; + for (int i = n_dims - 1; i >= 0; i--) { + std::string start = "0", length = "0"; if( lower_bounds ) { visit_expr(*lower_bounds->m_args[i]); - } else { - src = "0"; + start = src; } - dim_set_code += indent + dest_src + "->dims[" + - std::to_string(i) + "].lower_bound = " + src + ";\n"; if( m_dims[i].m_length ) { - visit_expr(*m_dims[i].m_length); - } else { - src = "0"; + this->visit_expr(*m_dims[i].m_length); + length = src; } - dim_set_code += indent + dest_src + "->dims[" + - std::to_string(i) + "].length = " + src + ";\n"; + dim_set_code += indent + dest_src + + "->dims[" + std::to_string(i) + "].lower_bound = " + start + ";\n"; + dim_set_code += indent + dest_src + + "->dims[" + std::to_string(i) + "].length = " + length + ";\n"; + dim_set_code += indent + dest_src + + "->dims[" + std::to_string(i) + "].stride = " + stride + ";\n"; + stride = "(" + stride + "*" + length + ")"; } src.clear(); src += dim_set_code; @@ -1210,7 +1209,7 @@ R"( // Initialise Numpy src = this->check_tmp_buffer() + out; } - void visit_ArrayBroadcast(const ASR::ArrayBroadcast_t& x) { + void visit_ArrayBroadcast(const ASR::ArrayBroadcast_t &x) { /* !LF$ attributes simd :: A real :: A(8) @@ -1218,24 +1217,15 @@ R"( // Initialise Numpy We need to generate: a = {1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0}; */ - - CHECK_FAST_C(compiler_options, x) - if (x.m_value) { - ASR::expr_t* value = x.m_value; - LCOMPILERS_ASSERT(ASR::is_a(*value)); - ASR::ArrayConstant_t* array_const = ASR::down_cast(value); - std::string array_const_str = "{"; - for( size_t i = 0; i < array_const->n_args; i++ ) { - ASR::expr_t* array_const_arg = array_const->m_args[i]; - this->visit_expr(*array_const_arg); - array_const_str += src + ", "; - } - array_const_str.pop_back(); - array_const_str.pop_back(); - array_const_str += "}"; - - src = array_const_str; + size_t size = ASRUtils::get_fixed_size_of_array(x.m_type); + std::string array_const_str = "{"; + for( size_t i = 0; i < size; i++ ) { + this->visit_expr(*x.m_array); + array_const_str += src; + if (i < size - 1) array_const_str += ", "; } + array_const_str += "}"; + src = array_const_str; } void visit_ArraySize(const ASR::ArraySize_t& x) { @@ -1288,12 +1278,21 @@ R"( // Initialise Numpy visit_expr(*x.m_dim); std::string idx = src; if( x.m_bound == ASR::arrayboundType::LBound ) { - src = "((" + result_type + ")" + var_name + "->dims[" + idx + "-1].lower_bound)"; + if (ASRUtils::is_simd_array(x.m_v)) { + src = "0"; + } else { + src = "((" + result_type + ")" + var_name + "->dims[" + idx + "-1].lower_bound)"; + } } else if( x.m_bound == ASR::arrayboundType::UBound ) { - std::string lower_bound = var_name + "->dims[" + idx + "-1].lower_bound"; - std::string length = var_name + "->dims[" + idx + "-1].length"; - std::string upper_bound = length + " + " + lower_bound + " - 1"; - src = "((" + result_type + ") " + upper_bound + ")"; + if (ASRUtils::is_simd_array(x.m_v)) { + int64_t size = ASRUtils::get_fixed_size_of_array(ASRUtils::expr_type(x.m_v)); + src = std::to_string(size - 1); + } else { + std::string lower_bound = var_name + "->dims[" + idx + "-1].lower_bound"; + std::string length = var_name + "->dims[" + idx + "-1].length"; + std::string upper_bound = length + " + " + lower_bound + " - 1"; + src = "((" + result_type + ") " + upper_bound + ")"; + } } } @@ -1321,51 +1320,86 @@ R"( // Initialise Numpy CHECK_FAST_C(compiler_options, x) this->visit_expr(*x.m_v); std::string array = src; - std::string out = array; ASR::ttype_t* x_mv_type = ASRUtils::expr_type(x.m_v); ASR::dimension_t* m_dims; int n_dims = ASRUtils::extract_dimensions_from_ttype(x_mv_type, m_dims); bool is_data_only_array = ASRUtils::is_fixed_size_array(m_dims, n_dims) && ASR::is_a(*ASRUtils::get_asr_owner(x.m_v)); - if( is_data_only_array ) { + if( is_data_only_array || ASRUtils::is_simd_array(x.m_v)) { + std::string index = ""; + std::string out = array; out += "["; - } else { - out += "->data["; - } - std::string index = ""; - for (size_t i=0; ivisit_expr(*x.m_args[i].m_right); - } else { - src = "/* FIXME right index */"; - } + for (size_t i=0; ivisit_expr(*x.m_args[i].m_right); + } else { + src = "/* FIXME right index */"; + } - if( is_data_only_array ) { - current_index += src; - for( size_t j = i + 1; j < x.n_args; j++ ) { - int64_t dim_size = 0; - ASRUtils::extract_value(m_dims[j].m_length, dim_size); - std::string length = std::to_string(dim_size); - current_index += " * " + length; + if (ASRUtils::is_simd_array(x.m_v)) { + index += src; + } else { + std::string current_index = ""; + current_index += src; + for( size_t j = 0; j < i; j++ ) { + int64_t dim_size = 0; + ASRUtils::extract_value(m_dims[j].m_length, dim_size); + std::string length = std::to_string(dim_size); + current_index += " * " + length; + } + index += current_index; } - index += current_index; - } else { - current_index += "(" + src + " - " + array + "->dims[" - + std::to_string(i) + "].lower_bound)"; - for( size_t j = i + 1; j < x.n_args; j++ ) { - std::string length = array + "->dims[" + std::to_string(j) + "].length"; - current_index += " * " + length; + if (i < x.n_args - 1) { + index += " + "; } - index += current_index; } - if (i < x.n_args - 1) { - index += " + "; + out += index + "]"; + last_expr_precedence = 2; + src = out; + return; + } + + std::vector indices; + for( size_t r = 0; r < x.n_args; r++ ) { + ASR::array_index_t curr_idx = x.m_args[r]; + this->visit_expr(*curr_idx.m_right); + indices.push_back(src); + } + + ASR::ttype_t* x_mv_type_ = ASRUtils::type_get_past_allocatable( + ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_const(x_mv_type))); + LCOMPILERS_ASSERT(ASR::is_a(*x_mv_type_)); + ASR::Array_t* array_t = ASR::down_cast(x_mv_type_); + std::vector diminfo; + if( array_t->m_physical_type == ASR::array_physical_typeType::PointerToDataArray || + array_t->m_physical_type == ASR::array_physical_typeType::FixedSizeArray ) { + for( size_t idim = 0; idim < x.n_args; idim++ ) { + this->visit_expr(*m_dims[idim].m_start); + diminfo.push_back(src); + this->visit_expr(*m_dims[idim].m_length); + diminfo.push_back(src); } + } else if( array_t->m_physical_type == ASR::array_physical_typeType::UnboundedPointerToDataArray ) { + for( size_t idim = 0; idim < x.n_args; idim++ ) { + this->visit_expr(*m_dims[idim].m_start); + diminfo.push_back(src); + } + } + + LCOMPILERS_ASSERT(ASRUtils::extract_n_dims_from_ttype(x_mv_type) > 0); + if (array_t->m_physical_type == ASR::array_physical_typeType::UnboundedPointerToDataArray) { + src = arr_get_single_element(array, indices, x.n_args, + true, + false, + diminfo, + true); + } else { + src = arr_get_single_element(array, indices, x.n_args, + array_t->m_physical_type == ASR::array_physical_typeType::PointerToDataArray, + array_t->m_physical_type == ASR::array_physical_typeType::FixedSizeArray, + diminfo, false); } - out += index + "]"; last_expr_precedence = 2; - src = out; } void visit_StringItem(const ASR::StringItem_t& x) { diff --git a/src/libasr/codegen/asr_to_c_cpp.h b/src/libasr/codegen/asr_to_c_cpp.h index 9536b69..cd8d0cb 100644 --- a/src/libasr/codegen/asr_to_c_cpp.h +++ b/src/libasr/codegen/asr_to_c_cpp.h @@ -24,6 +24,8 @@ #include #include #include +#include + #include #include @@ -93,6 +95,11 @@ class BaseCCPPVisitor : public ASR::BaseVisitor public: diag::Diagnostics &diag; Platform platform; + // `src` acts as a buffer that accumulates the generated C/C++ source code + // as the visitor traverses all the ASR nodes of a program. Each visitor method + // uses `src` to return the result, and the caller visitor uses `src` as the + // value of the callee visitors it calls. The C/C++ complete source code + // is then recursively constructed using `src`. std::string src; std::string current_body; CompilerOptions &compiler_options; @@ -206,7 +213,7 @@ class BaseCCPPVisitor : public ASR::BaseVisitor // Include dimension_descriptor definition that is used by array types if (array_types_decls.size() != 0) { array_types_decls = "\nstruct dimension_descriptor\n" - "{\n int32_t lower_bound, length;\n};\n" + array_types_decls; + "{\n int32_t lower_bound, length, stride;\n};\n" + array_types_decls; } return to_include + head + array_types_decls + forward_decl_functions + unit_src + @@ -927,6 +934,8 @@ R"(#include s_array_)" + arg_name + R"(->n_dims = 1; s_array_)" + arg_name + R"(->dims[0].lower_bound = 0; s_array_)" + arg_name + R"(->dims[0].length = dims[0]; + s_array_)" + arg_name + R"(->dims[0].stride = 1; + s_array_)" + arg_name + R"(->offset = 0; s_array_)" + arg_name + R"(->is_allocated = false; } )"; @@ -1049,13 +1058,14 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { } void visit_ArrayPhysicalCast(const ASR::ArrayPhysicalCast_t& x) { - src = ""; - this->visit_expr(*x.m_arg); - if (x.m_old == ASR::array_physical_typeType::FixedSizeArray && + src = ""; + this->visit_expr(*x.m_arg); + if (x.m_old == ASR::array_physical_typeType::FixedSizeArray && x.m_new == ASR::array_physical_typeType::SIMDArray) { std::string arr_element_type = CUtils::get_c_type_from_ttype_t(ASRUtils::expr_type(x.m_arg)); int64_t size = ASRUtils::get_fixed_size_of_array(ASRUtils::expr_type(x.m_arg)); - std::string cast = arr_element_type + " __attribute__ (( vector_size(sizeof(" + arr_element_type + ") * " + std::to_string(size) + ") ))"; + std::string cast = arr_element_type + " __attribute__ (( vector_size(sizeof(" + + arr_element_type + ") * " + std::to_string(size) + ") ))"; src = "(" + cast + ") " + src; } } @@ -1070,12 +1080,19 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { ASR::is_a( *(ASR::down_cast(m_args[i].m_value)->m_v))) { ASR::Variable_t* param = ASRUtils::EXPR2VAR(f->m_args[i]); - if( (ASRUtils::is_array(type) && - ASRUtils::is_pointer(type)) - || (is_c && (param->m_intent == ASRUtils::intent_inout + if( (is_c && (param->m_intent == ASRUtils::intent_inout || param->m_intent == ASRUtils::intent_out) && !ASRUtils::is_aggregate_type(param->m_type))) { args += "&" + src; + } else if (param->m_intent == ASRUtils::intent_out) { + if (ASR::is_a(*param->m_type)) { + ASR::List_t* list_type = ASR::down_cast(param->m_type); + if (list_type->m_type->type == ASR::ttypeType::CPtr){ + args += "&" + src; + } + } else { + args += src; + } } else { args += src; } @@ -1248,7 +1265,37 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { bool is_value_dict = ASR::is_a(*m_value_type); bool alloc_return_var = false; std::string indent(indentation_level*indentation_spaces, ' '); - if (ASR::is_a(*x.m_target)) { + if (ASRUtils::is_simd_array(x.m_target)) { + this->visit_expr(*x.m_target); + target = src; + if (ASR::is_a(*x.m_value) || + ASR::is_a(*x.m_value)) { + std::string arr_element_type = CUtils::get_c_type_from_ttype_t( + ASRUtils::expr_type(x.m_value)); + std::string size = std::to_string(ASRUtils::get_fixed_size_of_array( + ASRUtils::expr_type(x.m_target))); + std::string value; + if (ASR::is_a(*x.m_value)) { + ASR::ArraySection_t *arr = ASR::down_cast(x.m_value); + this->visit_expr(*arr->m_v); + value = src; + if(!ASR::is_a(*arr->m_args->m_left)) { + this->visit_expr(*arr->m_args->m_left); + int n_dims = ASRUtils::extract_n_dims_from_ttype(arr->m_type) - 1; + value += "->data + (" + src + " - "+ value +"->dims[" + + std::to_string(n_dims) +"].lower_bound)"; + } else { + value += "->data"; + } + } else if (ASR::is_a(*x.m_value)) { + this->visit_expr(*x.m_value); + value = src + "->data"; + } + src = indent + "memcpy(&"+ target +", "+ value +", sizeof(" + + arr_element_type + ") * "+ size +");\n"; + return; + } + } else if (ASR::is_a(*x.m_target)) { ASR::Var_t* x_m_target = ASR::down_cast(x.m_target); visit_Var(*x_m_target); target = src; @@ -1339,7 +1386,19 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { if( is_target_list && is_value_list ) { ASR::List_t* list_target = ASR::down_cast(ASRUtils::expr_type(x.m_target)); std::string list_dc_func = c_ds_api->get_list_deepcopy_func(list_target); - src += indent + list_dc_func + "(&" + value + ", &" + target + ");\n\n"; + if (ASR::is_a(*x.m_target)) { + ASR::symbol_t *target_sym = ASR::down_cast(x.m_target)->m_v; + if (ASR::is_a(*target_sym)) { + ASR::Variable_t *v = ASR::down_cast(target_sym); + if (v->m_intent == ASRUtils::intent_out) { + src += indent + list_dc_func + "(&" + value + ", " + target + ");\n\n"; + } else { + src += indent + list_dc_func + "(&" + value + ", &" + target + ");\n\n"; + } + } + } else { + src += indent + list_dc_func + "(&" + value + ", &" + target + ");\n\n"; + } } else if ( is_target_tup && is_value_tup ) { ASR::Tuple_t* tup_target = ASR::down_cast(ASRUtils::expr_type(x.m_target)); std::string dc_func = c_ds_api->get_tuple_deepcopy_func(tup_target); @@ -1400,32 +1459,183 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { from_std_vector_helper.clear(); } - void visit_Associate(const ASR::Associate_t &x) { - if (ASR::is_a(*x.m_value)) { - self().visit_expr(*x.m_target); - std::string target = std::move(src); - // ArraySection(expr v, array_index* args, ttype type, expr? value) - ASR::ArraySection_t *as = ASR::down_cast(x.m_value); - self().visit_expr(*as->m_v); - std::string value = std::move(src); - std::string c = ""; - for( size_t i = 0; i < as->n_args; i++ ) { - std::string left, right, step; - if (as->m_args[i].m_left) { - self().visit_expr(*as->m_args[i].m_left); - left = std::move(src); + std::string cmo_convertor_single_element( + std::string arr, std::vector& m_args, + int n_args, bool check_for_bounds) { + std::string dim_des_arr_ptr = arr + "->dims"; + std::string idx = "0"; + for( int r = 0; r < n_args; r++ ) { + std::string curr_llvm_idx = m_args[r]; + std::string dim_des_ptr = dim_des_arr_ptr + "[" + std::to_string(r) + "]"; + std::string lval = dim_des_ptr + ".lower_bound"; + curr_llvm_idx = "(" + curr_llvm_idx + " - " + lval + ")"; + if( check_for_bounds ) { + // check_single_element(curr_llvm_idx, arr); TODO: To be implemented + } + std::string stride = dim_des_ptr + ".stride"; + idx = "(" + idx + " + (" + stride + " * " + curr_llvm_idx + "))"; + } + std::string offset_val = arr + "->offset"; + return "(" + idx + " + " + offset_val + ")"; + } + + std::string cmo_convertor_single_element_data_only( + std::vector& diminfo, std::vector& m_args, + int n_args, bool check_for_bounds, bool is_unbounded_pointer_to_data) { + std::string prod = "1"; + std::string idx = "0"; + if (is_unbounded_pointer_to_data) { + for (int r = 0; r < n_args; r++) { + std::string curr_llvm_idx = m_args[r]; + std::string lval = diminfo[r]; + curr_llvm_idx = "(" + curr_llvm_idx + " - " + lval + ")"; + if( check_for_bounds ) { + // check_single_element(curr_llvm_idx, arr); TODO: To be implemented } - if (as->m_args[i].m_right) { - self().visit_expr(*as->m_args[i].m_right); - right = std::move(src); - } - if (as->m_args[i].m_step) { - self().visit_expr(*as->m_args[i].m_step); - step = std::move(src); + idx = "(" + idx + " + " + "(" + curr_llvm_idx + ")" + ")"; + } + return idx; + } + for( int r = n_args - 1, r1 = 2 * n_args - 1; r >= 0; r--, r1 -= 2) { + std::string curr_llvm_idx = m_args[r]; + std::string lval = diminfo[r1 - 1]; + curr_llvm_idx = "(" + curr_llvm_idx + " - " + lval + ")"; + if( check_for_bounds ) { + // check_single_element(curr_llvm_idx, arr); TODO: To be implemented + } + idx = "(" + idx + " + " + "(" + prod + " * " + curr_llvm_idx + ")" + ")"; + std::string dim_size = diminfo[r1]; + prod = "(" + prod + " * " + dim_size + ")"; + } + return idx; + } + + std::string arr_get_single_element(std::string array, + std::vector& m_args, int n_args, bool data_only, + bool is_fixed_size, std::vector& diminfo, bool is_unbounded_pointer_to_data) { + std::string tmp = ""; + // TODO: Uncomment later + // bool check_for_bounds = is_explicit_shape(v); + bool check_for_bounds = false; + std::string idx = ""; + if( data_only || is_fixed_size ) { + LCOMPILERS_ASSERT(diminfo.size() > 0); + idx = cmo_convertor_single_element_data_only(diminfo, m_args, n_args, check_for_bounds, is_unbounded_pointer_to_data); + if( is_fixed_size ) { + tmp = array + "->data[" + idx + "]" ; + } else { + tmp = array + "->data[" + idx + "]"; + } + } else { + idx = cmo_convertor_single_element(array, m_args, n_args, check_for_bounds); + std::string full_array = array + "->data"; + tmp = full_array + "[" + idx + "]"; + } + return tmp; + } + + void fill_descriptor_for_array_section_data_only(std::string value_desc, std::string target_desc, + std::vector& lbs, std::vector& ubs, std::vector& ds, std::vector& non_sliced_indices, + std::vector& diminfo, int value_rank, int target_rank) { + std::string indent(indentation_level * indentation_spaces, ' '); + std::vector section_first_indices; + for( int i = 0; i < value_rank; i++ ) { + if( ds[i] != "" ) { + LCOMPILERS_ASSERT(lbs[i] != ""); + section_first_indices.push_back(lbs[i]); + } else { + LCOMPILERS_ASSERT(non_sliced_indices[i] != ""); + section_first_indices.push_back(non_sliced_indices[i]); } - c += left + ":" + right + ":" + step + ","; } - src = target + "= " + value + "; // TODO: " + value + "(" + c + ")\n"; + std::string target_offset = cmo_convertor_single_element_data_only( + diminfo, section_first_indices, value_rank, false, false); + + value_desc = "(" + value_desc + " + " + target_offset + ")"; + std::string update_target_desc = ""; + update_target_desc += indent + target_desc + "->data = " + value_desc + ";\n"; + + update_target_desc += indent + target_desc + "->offset = 0;\n"; // offset not available yet + + std::string target_dim_des_array = target_desc + "->dims"; + int j = target_rank - 1; + int r = (int)diminfo.size() - 1; + std::string stride = "1"; + for( int i = value_rank - 1; i >= 0; i-- ) { + if( ds[i] != "" ) { + std::string dim_length = "(((" + ubs[i] + " - " + lbs[i] + ")" + "/" + ds[i] + ") + 1)"; + std::string target_dim_des = target_dim_des_array + "[" + std::to_string(j) + "]"; + update_target_desc += indent + target_dim_des + ".stride = " + stride + ";\n"; + update_target_desc += indent + target_dim_des + ".lower_bound = 1;\n"; + update_target_desc += indent + target_dim_des + ".length = " + dim_length + ";\n"; + j--; + } + stride = "(" + stride + "*" + diminfo[r] + ")"; + r -= 2; + } + LCOMPILERS_ASSERT(j == -1); + update_target_desc += indent + target_desc + "->n_dims = " + std::to_string(target_rank) + ";\n"; + src = update_target_desc; + } + + void handle_array_section_association_to_pointer(const ASR::Associate_t& x) { + ASR::ArraySection_t* array_section = ASR::down_cast(x.m_value); + self().visit_expr(*array_section->m_v); + std::string value_desc = src; + + self().visit_expr(*x.m_target); + std::string target_desc = src; + + int value_rank = array_section->n_args, target_rank = 0; + std::vector lbs(value_rank); + std::vector ubs(value_rank); + std::vector ds(value_rank); + std::vector non_sliced_indices(value_rank); + for( int i = 0; i < value_rank; i++ ) { + lbs[i] = ""; ubs[i] = ""; ds[i] = ""; + non_sliced_indices[i] = ""; + if( array_section->m_args[i].m_step != nullptr ) { + self().visit_expr(*array_section->m_args[i].m_left); + lbs[i] = src; + self().visit_expr(*array_section->m_args[i].m_right); + ubs[i] = src; + self().visit_expr(*array_section->m_args[i].m_step); + ds[i] = src; + target_rank++; + } else { + self().visit_expr(*array_section->m_args[i].m_right); + non_sliced_indices[i] = src; + } + } + LCOMPILERS_ASSERT(target_rank > 0); + + ASR::ttype_t* array_type = ASRUtils::expr_type(array_section->m_v); + if( ASRUtils::extract_physical_type(array_type) == ASR::array_physical_typeType::PointerToDataArray || + ASRUtils::extract_physical_type(array_type) == ASR::array_physical_typeType::FixedSizeArray ) { + value_desc = value_desc + "->data"; + ASR::dimension_t* m_dims = nullptr; + // Fill in m_dims: + [[maybe_unused]] int array_value_rank = ASRUtils::extract_dimensions_from_ttype(array_type, m_dims); + LCOMPILERS_ASSERT(array_value_rank == value_rank); + std::vector diminfo; + diminfo.reserve(value_rank * 2); + for( int i = 0; i < value_rank; i++ ) { + self().visit_expr(*m_dims[i].m_start); + diminfo.push_back(src); + self().visit_expr(*m_dims[i].m_length); + diminfo.push_back(src); + } + fill_descriptor_for_array_section_data_only(value_desc, target_desc, + lbs, ubs, ds, non_sliced_indices, + diminfo, value_rank, target_rank); + } else { + throw CodeGenError("Only Pointer to Data Array or Fixed Size array supported for now"); + } + } + + void visit_Associate(const ASR::Associate_t &x) { + if (ASR::is_a(*x.m_value)) { + handle_array_section_association_to_pointer(x); } else { throw CodeGenError("Associate only implemented for ArraySection so far"); } @@ -2344,14 +2554,8 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { src += ASRUtils::binop_to_str_python(x.m_op); if (right_precedence == 3) { src += "(" + right + ")"; - } else if (x.m_op == ASR::binopType::Sub || x.m_op == ASR::binopType::Div) { - if (right_precedence < last_expr_precedence) { - src += right; - } else { - src += "(" + right + ")"; - } } else { - if (right_precedence <= last_expr_precedence) { + if (right_precedence < last_expr_precedence) { src += right; } else { src += "(" + right + ")"; @@ -2421,7 +2625,8 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { if (ASRUtils::is_array(type)) { std::string size_str = "1"; out += indent + sym + "->n_dims = " + std::to_string(x.m_args[i].n_dims) + ";\n"; - for (size_t j=0; j= 0; j--) { std::string st, l; if (x.m_args[i].m_dims[j].m_start) { self().visit_expr(*x.m_args[i].m_dims[j].m_start); @@ -2435,11 +2640,14 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { } else { l = "1"; } - size_str += "*" + l; + size_str += "*" + sym + "->dims[" + std::to_string(j) + "].length"; out += indent + sym + "->dims[" + std::to_string(j) + "].lower_bound = "; out += st + ";\n"; out += indent + sym + "->dims[" + std::to_string(j) + "].length = "; out += l + ";\n"; + out += indent + sym + "->dims[" + std::to_string(j) + "].stride = "; + out += stride + ";\n"; + stride = "(" + stride + " * " + l + ")"; } std::string ty = CUtils::get_c_type_from_ttype_t( ASRUtils::type_get_past_array( @@ -2827,11 +3035,16 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { } #define SET_INTRINSIC_NAME(X, func_name) \ - case (static_cast(ASRUtils::IntrinsicScalarFunctions::X)) : { \ + case (static_cast(ASRUtils::IntrinsicElementalFunctions::X)) : { \ out += func_name; break; \ } - void visit_IntrinsicScalarFunction(const ASR::IntrinsicScalarFunction_t &x) { + #define SET_INTRINSIC_SUBROUTINE_NAME(X, func_name) \ + case (static_cast(ASRUtils::IntrinsicImpureSubroutines::X)) : { \ + out += func_name; break; \ + } + + void visit_IntrinsicElementalFunction(const ASR::IntrinsicElementalFunction_t &x) { CHECK_FAST_C_CPP(compiler_options, x); std::string out; std::string indent(4, ' '); @@ -2852,8 +3065,22 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { SET_INTRINSIC_NAME(Trunc, "trunc"); SET_INTRINSIC_NAME(Fix, "fix"); SET_INTRINSIC_NAME(FloorDiv, "floordiv"); + SET_INTRINSIC_NAME(Char, "char"); + SET_INTRINSIC_NAME(StringContainsSet, "verify"); + SET_INTRINSIC_NAME(StringFindSet, "scan"); + SET_INTRINSIC_NAME(SubstrIndex, "index"); + case (static_cast(ASRUtils::IntrinsicElementalFunctions::FMA)) : { + this->visit_expr(*x.m_args[0]); + std::string a = src; + this->visit_expr(*x.m_args[1]); + std::string b = src; + this->visit_expr(*x.m_args[2]); + std::string c = src; + src = a +" + "+ b +"*"+ c; + return; + } default : { - throw LCompilersException("IntrinsicScalarFunction: `" + throw LCompilersException("IntrinsicElementalFunction: `" + ASRUtils::get_intrinsic_name(x.m_intrinsic_id) + "` is not implemented"); } @@ -2864,7 +3091,11 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) { src = out; } - void visit_IntrinsicFunctionSqrt(const ASR::IntrinsicFunctionSqrt_t &x) { + void visit_TypeInquiry(const ASR::TypeInquiry_t &x) { + this->visit_expr(*x.m_value); + } + + void visit_RealSqrt(const ASR::RealSqrt_t &x) { std::string out = "sqrt"; headers.insert("math.h"); this->visit_expr(*x.m_arg); diff --git a/src/libasr/codegen/asr_to_fortran.cpp b/src/libasr/codegen/asr_to_fortran.cpp index dae695c..04a0942 100644 --- a/src/libasr/codegen/asr_to_fortran.cpp +++ b/src/libasr/codegen/asr_to_fortran.cpp @@ -28,7 +28,12 @@ enum Precedence { class ASRToFortranVisitor : public ASR::BaseVisitor { public: - std::string s; + // `src` acts as a buffer that accumulates the generated Fortran source code + // as the visitor traverses all the ASR nodes of a program. Each visitor method + // uses `src` to return the result, and the caller visitor uses `src` as the + // value of the callee visitors it calls. The Fortran complete source code + // is then recursively constructed using `src`. + std::string src; bool use_colors; int indent_level; std::string indent; @@ -37,6 +42,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor // in the Fortran 2018 standard int last_expr_precedence; std::string format_string; + std::string tu_functions; // Used for importing struct type inside interface bool is_interface = false; @@ -63,7 +69,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor visit_expr(x); if (last_expr_precedence == 9 || last_expr_precedence < current_precedence) { - s = "(" + s + ")"; + src = "(" + src + ")"; } } @@ -130,13 +136,22 @@ class ASRToFortranVisitor : public ASR::BaseVisitor } for (size_t i = 0; i < x.n_body; i++) { visit_stmt(*x.m_body[i]); - r += s; + r += src; } if (apply_indent) { dec_indent(); } } + void handle_line_truncation(std::string &r, int i_level, int line_length=80) { + int line_segments_count = r.size()/line_length; + for (int i = 1; i <= line_segments_count; i ++) { + int index = r.find_last_of(',', line_length*i); + r.insert(index + 2, "&\n" + indent + + std::string(i_level*indent_spaces, ' ')); + } + } + std::string get_type(const ASR::ttype_t *t) { std::string r = ""; switch (t->type) { @@ -167,7 +182,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += ":"; } else if (c->m_len == -3) { visit_expr(*c->m_len_expr); - r += s; + r += src; } } r += ", kind="; @@ -187,11 +202,11 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string start = "", len = ""; if (arr_type->m_dims[i].m_start) { visit_expr(*arr_type->m_dims[i].m_start); - start = s; + start = src; } if (arr_type->m_dims[i].m_length) { visit_expr(*arr_type->m_dims[i].m_length); - len = s; + len = src; } if (len.length() == 0) { @@ -237,12 +252,12 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string r = "", m_op = cmpop2str(x.m_op); int current_precedence = last_expr_precedence; visit_expr_with_precedence(*x.m_left, current_precedence); - r += s; + r += src; r += m_op; visit_expr_with_precedence(*x.m_right, current_precedence); - r += s; + r += src; last_expr_precedence = current_precedence; - s = r; + src = r; } /********************************** Unit **********************************/ @@ -251,24 +266,28 @@ class ASRToFortranVisitor : public ASR::BaseVisitor for (auto &item : x.m_symtab->get_scope()) { if (is_a(*item.second)) { visit_symbol(*item.second); - r += s; + r += src; + r += "\n"; } } + tu_functions = ""; for (auto &item : x.m_symtab->get_scope()) { if (is_a(*item.second)) { visit_symbol(*item.second); - r += s; + tu_functions += src; + tu_functions += "\n"; } } + // Main program for (auto &item : x.m_symtab->get_scope()) { if (is_a(*item.second)) { visit_symbol(*item.second); - r += s; + r += src; } } - s = r; + src = r; } /********************************* Symbol *********************************/ @@ -281,7 +300,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor for (auto &item : x.m_symtab->get_scope()) { if (is_a(*item.second)) { visit_symbol(*item.second); - r += s; + r += src; } } r += indent + "implicit none"; @@ -304,14 +323,14 @@ class ASRToFortranVisitor : public ASR::BaseVisitor for (auto &item : struct_deps) { ASR::symbol_t* struct_sym = x.m_symtab->get_symbol(item); visit_symbol(*struct_sym); - r += s; + r += src; } std::vector var_order = ASRUtils::determine_variable_declaration_order(x.m_symtab); for (auto &item : var_order) { ASR::symbol_t* var_sym = x.m_symtab->get_symbol(item); if (is_a(*var_sym)) { visit_symbol(*var_sym); - r += s; + r += src; } } @@ -327,14 +346,23 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "\n\n"; } visit_symbol(*item.second); - r += s; + r += src; + r += "\n"; + } + } + if (tu_functions.size() > 0) { + if (prepend_contains_keyword) { + r += "\n"; + r += "contains"; + r += "\n\n"; } + r += tu_functions; } r += "end program"; r += " "; r.append(x.m_name); r += "\n"; - s = r; + src = r; } void visit_Module(const ASR::Module_t &x) { @@ -346,7 +374,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor for (auto &item : x.m_symtab->get_scope()) { if (is_a(*item.second)) { visit_symbol(*item.second); - r += s; + r += src; } } r += indent + "implicit none"; @@ -354,7 +382,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor for (auto &item : x.m_symtab->get_scope()) { if (is_a(*item.second)) { visit_symbol(*item.second); - r += s; + r += src; } } @@ -376,14 +404,14 @@ class ASRToFortranVisitor : public ASR::BaseVisitor for (auto &item : struct_deps) { ASR::symbol_t* struct_sym = x.m_symtab->get_symbol(item); visit_symbol(*struct_sym); - r += s; + r += src; } std::vector var_order = ASRUtils::determine_variable_declaration_order(x.m_symtab); for (auto &item : var_order) { ASR::symbol_t* var_sym = x.m_symtab->get_symbol(item); if (is_a(*var_sym)) { visit_symbol(*var_sym); - r += s; + r += src; } } std::vector func_name; @@ -405,7 +433,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor inc_indent(); } visit_symbol(*x.m_symtab->get_symbol(interface_func_name[i])); - r += s; + r += src; if (i < interface_func_name.size() - 1) { r += "\n"; } else { @@ -421,14 +449,14 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "\n\n"; } visit_symbol(*x.m_symtab->get_symbol(func_name[i])); - r += s; + r += src; if (i < func_name.size()) r += "\n"; } r += "end module"; r += " "; r.append(x.m_name); r += "\n"; - s = r; + src = r; } void visit_Function(const ASR::Function_t &x) { @@ -456,10 +484,11 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; for (size_t i = 0; i < x.n_args; i ++) { visit_expr(*x.m_args[i]); - r += s; + r += src; if (i < x.n_args-1) r += ", "; } r += ")"; + handle_line_truncation(r, 2); if (type->m_abi == ASR::abiType::BindC) { r += " bind(c"; if (type->m_bindc_name) { @@ -473,7 +502,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor if (x.m_return_var) { LCOMPILERS_ASSERT(is_a(*x.m_return_var)); visit_expr(*x.m_return_var); - return_var = s; + return_var = src; if (strcmp(x.m_name, return_var.c_str())) { r += " result(" + return_var + ")"; } @@ -489,7 +518,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor ASR::symbol_t* var_sym = x.m_symtab->get_symbol(item); if (is_a(*var_sym)) { visit_symbol(*var_sym); - variable_declaration += s; + variable_declaration += src; } } for (size_t i = 0; i < import_struct_type.size(); i ++) { @@ -518,7 +547,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "interface\n"; inc_indent(); visit_symbol(*item.second); - r += s; + r += src; r += "\n"; dec_indent(); r += indent; @@ -542,7 +571,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " "; r.append(x.m_name); r += "\n"; - s = r; + src = r; } void visit_GenericProcedure(const ASR::GenericProcedure_t &x) { @@ -562,7 +591,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "end interface "; r.append(x.m_name); r += "\n"; - s = r; + src = r; } // void visit_CustomOperator(const ASR::CustomOperator_t &x) {} @@ -571,12 +600,12 @@ class ASRToFortranVisitor : public ASR::BaseVisitor ASR::symbol_t *sym = down_cast( ASRUtils::symbol_parent_symtab(x.m_external)->asr_owner); if (!is_a(*sym)) { - s = indent; - s += "use "; - s.append(x.m_module_name); - s += ", only: "; - s.append(x.m_original_name); - s += "\n"; + src = indent; + src += "use "; + src.append(x.m_module_name); + src += ", only: "; + src.append(x.m_original_name); + src += "\n"; } } @@ -591,14 +620,14 @@ class ASRToFortranVisitor : public ASR::BaseVisitor ASR::symbol_t* var_sym = x.m_symtab->get_symbol(item); if (is_a(*var_sym)) { visit_symbol(*var_sym); - r += s; + r += src; } } dec_indent(); r += "end type "; r.append(x.m_name); r += "\n"; - s = r; + src = r; } // void visit_EnumType(const ASR::EnumType_t &x) {} @@ -645,17 +674,21 @@ class ASRToFortranVisitor : public ASR::BaseVisitor } r += " :: "; r.append(x.m_name); - if (x.m_value) { + if (x.m_symbolic_value && x.m_value && ASR::is_a(*x.m_symbolic_value) && ASR::is_a(*x.m_value)) { + r += " = "; + visit_expr(*x.m_symbolic_value); + r += src; + } else if (x.m_value) { r += " = "; visit_expr(*x.m_value); - r += s; + r += src; } else if (x.m_symbolic_value) { r += " = "; visit_expr(*x.m_symbolic_value); - r += s; + r += src; } r += "\n"; - s = r; + src = r; } // void visit_ClassType(const ASR::ClassType_t &x) {} @@ -676,19 +709,20 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "allocate("; for (size_t i = 0; i < x.n_args; i ++) { visit_expr(*x.m_args[i].m_a); - r += s; + r += src; if (x.m_args[i].n_dims > 0) { r += "("; for (size_t j = 0; j < x.m_args[i].n_dims; j ++) { visit_expr(*x.m_args[i].m_dims[j].m_length); - r += s; + r += src; if (j < x.m_args[i].n_dims-1) r += ", "; } r += ")"; } + if (i < x.n_args-1) r += ", "; } r += ")\n"; - s = r; + src = r; } // void visit_ReAlloc(const ASR::ReAlloc_t &x) {} @@ -703,49 +737,60 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " "; r += x.m_variable; r += "\n"; - s = r; + src = r; } void visit_Assignment(const ASR::Assignment_t &x) { std::string r = indent; visit_expr(*x.m_target); - r += s; + r += src; r += " = "; visit_expr(*x.m_value); - r += s; + r += src; r += "\n"; - s = r; + src = r; } void visit_Associate(const ASR::Associate_t &x) { visit_expr(*x.m_target); - std::string t = std::move(s); + std::string t = std::move(src); visit_expr(*x.m_value); - std::string v = std::move(s); - s = t + " => " + v + "\n"; + std::string v = std::move(src); + src = t + " => " + v + "\n"; } void visit_Cycle(const ASR::Cycle_t &x) { - s = indent + "cycle"; + src = indent + "cycle"; if (x.m_stmt_name) { - s += " " + std::string(x.m_stmt_name); + src += " " + std::string(x.m_stmt_name); } - s += "\n"; + src += "\n"; } - // void visit_ExplicitDeallocate(const ASR::ExplicitDeallocate_t &x) {} + void visit_ExplicitDeallocate(const ASR::ExplicitDeallocate_t &x) { + std::string r = indent; + r += "deallocate("; + for (size_t i = 0; i < x.n_vars; i ++) { + visit_expr(*x.m_vars[i]); + r += src; + if (i < x.n_vars-1) r += ", "; + } + r += ")"; + r += "\n"; + src = r; + } void visit_ImplicitDeallocate(const ASR::ImplicitDeallocate_t &x) { std::string r = indent; r += "deallocate("; for (size_t i = 0; i < x.n_vars; i ++) { visit_expr(*x.m_vars[i]); - r += s; + r += src; if (i < x.n_vars-1) r += ", "; } r += ") "; r += "! Implicit deallocate\n"; - s = r; + src = r; } // void visit_DoConcurrentLoop(const ASR::DoConcurrentLoop_t &x) {} @@ -759,17 +804,17 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "do "; visit_expr(*x.m_head.m_v); - r += s; + r += src; r += " = "; visit_expr(*x.m_head.m_start); - r += s; + r += src; r += ", "; visit_expr(*x.m_head.m_end); - r += s; + r += src; if (x.m_head.m_increment) { r += ", "; visit_expr(*x.m_head.m_increment); - r += s; + r += src; } r += "\n"; visit_body(x, r); @@ -779,21 +824,21 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " " + std::string(x.m_name); } r += "\n"; - s = r; + src = r; } void visit_ErrorStop(const ASR::ErrorStop_t &/*x*/) { - s = indent; - s += "error stop"; - s += "\n"; + src = indent; + src += "error stop"; + src += "\n"; } void visit_Exit(const ASR::Exit_t &x) { - s = indent + "exit"; + src = indent + "exit"; if (x.m_stmt_name) { - s += " " + std::string(x.m_stmt_name); + src += " " + std::string(x.m_stmt_name); } - s += "\n"; + src += "\n"; } // void visit_ForAllSingle(const ASR::ForAllSingle_t &x) {} @@ -804,7 +849,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " "; r += std::to_string(x.m_target_id); r += "\n"; - s = r; + src = r; } void visit_GoToTarget(const ASR::GoToTarget_t &x) { @@ -813,7 +858,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " "; r += "continue"; r += "\n"; - s = r; + src = r; } void visit_If(const ASR::If_t &x) { @@ -821,7 +866,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "if"; r += " ("; visit_expr(*x.m_test); - r += s; + r += src; r += ") "; r += "then"; r += "\n"; @@ -832,13 +877,13 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "\n"; inc_indent(); visit_stmt(*x.m_orelse[i]); - r += s; + r += src; dec_indent(); } r += indent; r += "end if"; r += "\n"; - s = r; + src = r; } // void visit_IfArithmetic(const ASR::IfArithmetic_t &x) {} @@ -851,20 +896,20 @@ class ASRToFortranVisitor : public ASR::BaseVisitor ASR::StringFormat_t *sf = down_cast(x.m_values[0]); visit_expr(*sf->m_fmt); if (is_a(*sf->m_fmt) - && (!startswith(s, "\"(") || !endswith(s, ")\""))) { - s = "\"(" + s.substr(1, s.size()-2) + ")\""; + && (!startswith(src, "\"(") || !endswith(src, ")\""))) { + src = "\"(" + src.substr(1, src.size()-2) + ")\""; } - r += s; + r += src; } else { r += "*"; } for (size_t i = 0; i < x.n_values; i++) { r += ", "; visit_expr(*x.m_values[i]); - r += s; + r += src; } r += "\n"; - s = r; + src = r; } void visit_FileOpen(const ASR::FileOpen_t &x) { @@ -874,7 +919,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; if (x.m_newunit) { visit_expr(*x.m_newunit); - r += s; + r += src; } else { throw CodeGenError("open() function must be called with a file unit number"); } @@ -882,23 +927,23 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += ", "; r += "file="; visit_expr(*x.m_filename); - r += s; + r += src; } if (x.m_status) { r += ", "; r += "status="; visit_expr(*x.m_status); - r += s; + r += src; } if (x.m_form) { r += ", "; r += "form="; visit_expr(*x.m_form); - r += s; + r += src; } r += ")"; r += "\n"; - s = r; + src = r; } void visit_FileClose(const ASR::FileClose_t &x) { @@ -908,13 +953,13 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; if (x.m_unit) { visit_expr(*x.m_unit); - r += s; + r += src; } else { throw CodeGenError("close() function must be called with a file unit number"); } r += ")"; r += "\n"; - s = r; + src = r; } void visit_FileRead(const ASR::FileRead_t &x) { @@ -924,7 +969,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; if (x.m_unit) { visit_expr(*x.m_unit); - r += s; + r += src; } else { r += "*"; } @@ -932,7 +977,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += ", "; r += "fmt="; visit_expr(*x.m_fmt); - r += s; + r += src; } else { r += ", *"; } @@ -940,28 +985,28 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += ", "; r += "iomsg="; visit_expr(*x.m_iomsg); - r += s; + r += src; } if (x.m_iostat) { r += ", "; r += "iostat="; visit_expr(*x.m_iostat); - r += s; + r += src; } if (x.m_id) { r += ", "; r += "id="; visit_expr(*x.m_id); - r += s; + r += src; } r += ") "; for (size_t i = 0; i < x.n_values; i++) { visit_expr(*x.m_values[i]); - r += s; + r += src; if (i < x.n_values - 1) r += ", "; } r += "\n"; - s = r; + src = r; } // void visit_FileBackspace(const ASR::FileBackspace_t &x) {} @@ -981,28 +1026,28 @@ class ASRToFortranVisitor : public ASR::BaseVisitor ASR::StringFormat_t *sf = down_cast(x.m_values[0]); visit_expr(*sf->m_fmt); if (is_a(*sf->m_fmt) - && (!startswith(s, "\"(") || !endswith(s, ")\""))) { - s = "\"(" + s.substr(1, s.size()-2) + ")\""; + && (!startswith(src, "\"(") || !endswith(src, ")\""))) { + src = "\"(" + src.substr(1, src.size()-2) + ")\""; } - r += s; + r += src; } else { r += "*"; } r += ") "; for (size_t i = 0; i < x.n_values; i++) { visit_expr(*x.m_values[i]); - r += s; + r += src; if (i < x.n_values-1) r += ", "; } r += "\n"; - s = r; + src = r; } void visit_Return(const ASR::Return_t &/*x*/) { std::string r = indent; r += "return"; r += "\n"; - s = r; + src = r; } void visit_Select(const ASR::Select_t &x) { @@ -1010,13 +1055,13 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "select case"; r += " ("; visit_expr(*x.m_test); - r += s; + r += src; r += ")\n"; inc_indent(); if (x.n_body > 0) { for(size_t i = 0; i < x.n_body; i ++) { visit_case_stmt(*x.m_body[i]); - r += s; + r += src; } } @@ -1026,20 +1071,20 @@ class ASRToFortranVisitor : public ASR::BaseVisitor inc_indent(); for(size_t i = 0; i < x.n_default; i ++) { visit_stmt(*x.m_default[i]); - r += s; + r += src; } dec_indent(); } dec_indent(); r += indent; r += "end select\n"; - s = r; + src = r; } void visit_Stop(const ASR::Stop_t /*x*/) { - s = indent; - s += "stop"; - s += "\n"; + src = indent; + src += "stop"; + src += "\n"; } // void visit_Assert(const ASR::Assert_t &x) {} @@ -1051,11 +1096,12 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; for (size_t i = 0; i < x.n_args; i ++) { visit_expr(*x.m_args[i].m_value); - r += s; + r += src; if (i < x.n_args-1) r += ", "; } r += ")\n"; - s = r; + handle_line_truncation(r, 1); + src = r; } void visit_Where(const ASR::Where_t &x) { @@ -1065,7 +1111,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " "; r += "("; visit_expr(*x.m_test); - r += s; + r += src; r += ")\n"; visit_body(x, r); for (size_t i = 0; i < x.n_orelse; i++) { @@ -1074,13 +1120,13 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "\n"; inc_indent(); visit_stmt(*x.m_orelse[i]); - r += s; + r += src; dec_indent(); } r += indent; r += "end where"; r += "\n"; - s = r; + src = r; } void visit_WhileLoop(const ASR::WhileLoop_t &x) { @@ -1092,7 +1138,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "do while"; r += " ("; visit_expr(*x.m_test); - r += s; + r += src; r += ")\n"; visit_body(x, r); r += indent; @@ -1101,7 +1147,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += " " + std::string(x.m_name); } r += "\n"; - s = r; + src = r; } // void visit_Nullify(const ASR::Nullify_t &x) {} @@ -1119,14 +1165,25 @@ class ASRToFortranVisitor : public ASR::BaseVisitor // void visit_Expr(const ASR::Expr_t &x) {} /********************************** Expr **********************************/ - // void visit_IfExp(const ASR::IfExp_t &x) {} + void visit_IfExp(const ASR::IfExp_t &x) { + std::string r = ""; + visit_expr(*x.m_test); + r += src; + r += " ? "; + visit_expr(*x.m_body); + r += src; + r += " : "; + visit_expr(*x.m_orelse); + r += src; + src = r; + } void visit_ComplexConstructor(const ASR::ComplexConstructor_t &x) { visit_expr(*x.m_re); - std::string re = s; + std::string re = src; visit_expr(*x.m_im); - std::string im = s; - s = "(" + re + ", " + im + ")"; + std::string im = src; + src = "(" + re + ", " + im + ")"; } // void visit_NamedExpr(const ASR::NamedExpr_t &x) {} @@ -1139,7 +1196,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += ASRUtils::symbol_name(x.m_name); } if (r == "bit_size") { - // TODO: Remove this once bit_size is implemented in IntrinsicScalarFunction + // TODO: Remove this once bit_size is implemented in IntrinsicElementalFunction visit_expr(*x.m_value); return; } @@ -1147,14 +1204,56 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; for (size_t i = 0; i < x.n_args; i ++) { visit_expr(*x.m_args[i].m_value); - r += s; + r += src; if (i < x.n_args-1) r += ", "; } r += ")"; - s = r; + src = r; + } + + void visit_TypeInquiry(const ASR::TypeInquiry_t &x) { + std::string out = ""; + switch (x.m_inquiry_id) { + SET_INTRINSIC_NAME(Epsilon, "epsilon" ); + SET_INTRINSIC_NAME(Huge, "huge" ); + SET_INTRINSIC_NAME(Precision, "precision"); + SET_INTRINSIC_NAME(Radix, "radix" ); + SET_INTRINSIC_NAME(Range, "range" ); + SET_INTRINSIC_NAME(Rank, "rank" ); + SET_INTRINSIC_NAME(Tiny, "tiny" ); + default : { + throw LCompilersException("TypeInquiry: `" + + ASRUtils::get_intrinsic_name(x.m_inquiry_id) + + "` is not implemented"); + } + } + this->visit_expr(*x.m_arg); + out += "(" + src + ")"; + src = out; } - void visit_IntrinsicScalarFunction(const ASR::IntrinsicScalarFunction_t &x) { + void visit_IntrinsicImpureSubroutine( const ASR::IntrinsicImpureSubroutine_t &x ) { + std::string out; + out = "call "; + switch ( x.m_intrinsic_id ) { + SET_INTRINSIC_SUBROUTINE_NAME(RandomNumber, "random_number"); + default : { + throw LCompilersException("IntrinsicImpureSubroutine: `" + + ASRUtils::get_intrinsic_name(x.m_intrinsic_id) + + "` is not implemented"); + } + } + out += "("; + for (size_t i = 0; i < x.n_args; i ++) { + visit_expr(*x.m_args[i]); + out += src; + if (i < x.n_args-1) out += ", "; + } + out += ")\n"; + src = out; + } + + void visit_IntrinsicElementalFunction(const ASR::IntrinsicElementalFunction_t &x) { std::string out; switch (x.m_intrinsic_id) { SET_INTRINSIC_NAME(Abs, "abs"); @@ -1162,16 +1261,26 @@ class ASRToFortranVisitor : public ASR::BaseVisitor SET_INTRINSIC_NAME(Max, "max"); SET_INTRINSIC_NAME(Min, "min"); SET_INTRINSIC_NAME(Sqrt, "sqrt"); + SET_INTRINSIC_NAME(Mod, "mod"); + SET_INTRINSIC_NAME(Sin, "sin"); + SET_INTRINSIC_NAME(Char, "char"); + SET_INTRINSIC_NAME(StringContainsSet, "verify"); + SET_INTRINSIC_NAME(StringFindSet, "scan"); + SET_INTRINSIC_NAME(SubstrIndex, "index"); default : { - throw LCompilersException("IntrinsicScalarFunction: `" + throw LCompilersException("IntrinsicElementalFunction: `" + ASRUtils::get_intrinsic_name(x.m_intrinsic_id) + "` is not implemented"); } } - LCOMPILERS_ASSERT(x.n_args == 1); - visit_expr(*x.m_args[0]); - out += "(" + s + ")"; - s = out; + out += "("; + for (size_t i = 0; i < x.n_args; i ++) { + visit_expr(*x.m_args[i]); + out += src; + if (i < x.n_args-1) out += ", "; + } + out += ")"; + src = out; } #define SET_ARR_INTRINSIC_NAME(X, func_name) \ @@ -1186,14 +1295,32 @@ class ASRToFortranVisitor : public ASR::BaseVisitor SET_ARR_INTRINSIC_NAME(Any, "any"); SET_ARR_INTRINSIC_NAME(Sum, "sum"); SET_ARR_INTRINSIC_NAME(Shape, "shape"); + SET_ARR_INTRINSIC_NAME(MaxVal, "maxval"); + SET_ARR_INTRINSIC_NAME(MinVal, "minval"); + case (static_cast(ASRUtils::IntrinsicArrayFunctions::Pack)) : { + out += "pack"; + visit_expr(*x.m_args[0]); + out += "(" + src + ", "; + visit_expr(*x.m_args[1]); + out += src; + if (x.n_args == 3) { + out += ", "; + visit_expr(*x.m_args[2]); + out += src; + } + out += ")"; + src = out; + out = ""; + break; + } default : { - throw LCompilersException("IntrinsicFunction: `" + throw LCompilersException("IntrinsicArrayFunction: `" + ASRUtils::get_array_intrinsic_name(x.m_arr_intrinsic_id) + "` is not implemented"); } } - out += "(" + s + ")"; - s = out; + out += "(" + src + ")"; + src = out; } // void visit_IntrinsicImpureFunction(const ASR::IntrinsicImpureFunction_t &x) {} @@ -1204,11 +1331,11 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "("; for(size_t i = 0; i < x.n_args; i++) { visit_expr(*x.m_args[i].m_value); - r += s; + r += src; if (i < x.n_args - 1) r += ", "; } r += ")"; - s = r; + src = r; } // void visit_EnumTypeConstructor(const ASR::EnumTypeConstructor_t &x) {} @@ -1218,7 +1345,13 @@ class ASRToFortranVisitor : public ASR::BaseVisitor // void visit_ImpliedDoLoop(const ASR::ImpliedDoLoop_t &x) {} void visit_IntegerConstant(const ASR::IntegerConstant_t &x) { - s = std::to_string(x.m_n); + src = std::to_string(x.m_n); + int kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); + if (kind != 4) { + // We skip this for default kind + src += "_"; + src += std::to_string(kind); + } last_expr_precedence = Precedence::Ext; } @@ -1228,7 +1361,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_IntegerUnaryMinus(const ASR::IntegerUnaryMinus_t &x) { visit_expr_with_precedence(*x.m_arg, 9); - s = "-" + s; + src = "-" + src; last_expr_precedence = Precedence::UnaryMinus; } @@ -1240,16 +1373,16 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string r = "", m_op = binop2str(x.m_op); int current_precedence = last_expr_precedence; visit_expr_with_precedence(*x.m_left, current_precedence); - r += s; + r += src; r += m_op; visit_expr_with_precedence(*x.m_right, current_precedence); if ((x.m_op == ASR::binopType::Sub && last_expr_precedence <= 8) || (x.m_op == ASR::binopType::Div && last_expr_precedence <= 10)) { - s = "(" + s + ")"; + src = "(" + src + ")"; } - r += s; + r += src; last_expr_precedence = current_precedence; - s = r; + src = r; } // void visit_UnsignedIntegerConstant(const ASR::UnsignedIntegerConstant_t &x) {} @@ -1265,16 +1398,16 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_RealConstant(const ASR::RealConstant_t &x) { int kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); if (kind >= 8) { - s = std::to_string(x.m_r) + "d0"; + src = std::to_string(x.m_r) + "d0"; } else { - s = std::to_string(x.m_r); + src = std::to_string(x.m_r); } last_expr_precedence = Precedence::Ext; } void visit_RealUnaryMinus(const ASR::RealUnaryMinus_t &x) { visit_expr_with_precedence(*x.m_arg, 9); - s = "-" + s; + src = "-" + src; last_expr_precedence = Precedence::UnaryMinus; } @@ -1286,12 +1419,12 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string r = "", m_op = binop2str(x.m_op); int current_precedence = last_expr_precedence; visit_expr_with_precedence(*x.m_left, current_precedence); - r += s; + r += src; r += m_op; visit_expr_with_precedence(*x.m_right, current_precedence); - r += s; + r += src; last_expr_precedence = current_precedence; - s = r; + src = r; } // void visit_RealCopySign(const ASR::RealCopySign_t &x) {} @@ -1299,12 +1432,12 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_ComplexConstant(const ASR::ComplexConstant_t &x) { std::string re = std::to_string(x.m_re); std::string im = std::to_string(x.m_im); - s = "(" + re + ", " + im + ")"; + src = "(" + re + ", " + im + ")"; } void visit_ComplexUnaryMinus(const ASR::ComplexUnaryMinus_t &x) { visit_expr_with_precedence(*x.m_arg, 9); - s = "-" + s; + src = "-" + src; last_expr_precedence = Precedence::UnaryMinus; } @@ -1316,28 +1449,28 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string r = "", m_op = binop2str(x.m_op); int current_precedence = last_expr_precedence; visit_expr_with_precedence(*x.m_left, current_precedence); - r += s; + r += src; r += m_op; visit_expr_with_precedence(*x.m_right, current_precedence); - r += s; + r += src; last_expr_precedence = current_precedence; - s = r; + src = r; } void visit_LogicalConstant(const ASR::LogicalConstant_t &x) { - s = "."; + src = "."; if (x.m_value) { - s += "true"; + src += "true"; } else { - s += "false"; + src += "false"; } - s += "."; + src += "."; last_expr_precedence = Precedence::Ext; } void visit_LogicalNot(const ASR::LogicalNot_t &x) { visit_expr_with_precedence(*x.m_arg, 5); - s = ".not. " + s; + src = ".not. " + src; last_expr_precedence = Precedence::Not; } @@ -1349,53 +1482,53 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string r = "", m_op = logicalbinop2str(x.m_op); int current_precedence = last_expr_precedence; visit_expr_with_precedence(*x.m_left, current_precedence); - r += s; + r += src; r += m_op; visit_expr_with_precedence(*x.m_right, current_precedence); - r += s; + r += src; last_expr_precedence = current_precedence; - s = r; + src = r; } void visit_StringConstant(const ASR::StringConstant_t &x) { - s = "\""; - s.append(x.m_s); - s += "\""; + src = "\""; + src.append(x.m_s); + src += "\""; last_expr_precedence = Precedence::Ext; } void visit_StringConcat(const ASR::StringConcat_t &x) { this->visit_expr(*x.m_left); - std::string left = std::move(s); + std::string left = std::move(src); this->visit_expr(*x.m_right); - std::string right = std::move(s); - s = left + "//" + right; + std::string right = std::move(src); + src = left + "//" + right; } void visit_StringRepeat(const ASR::StringRepeat_t &x) { this->visit_expr(*x.m_left); - std::string str = s; + std::string str = src; this->visit_expr(*x.m_right); - std::string n = s; - s = "repeat(" + str + ", " + n + ")"; + std::string n = src; + src = "repeat(" + str + ", " + n + ")"; } void visit_StringLen(const ASR::StringLen_t &x) { visit_expr(*x.m_arg); - s = "len(" + s + ")"; + src = "len(" + src + ")"; } void visit_StringItem(const ASR::StringItem_t &x) { std::string r = ""; this->visit_expr(*x.m_arg); - r += s; + r += src; r += "("; this->visit_expr(*x.m_idx); - r += s; + r += src; r += ":"; - r += s; + r += src; r += ")"; - s = r; + src = r; } // void visit_StringSection(const ASR::StringSection_t &x) {} @@ -1408,21 +1541,21 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_StringChr(const ASR::StringChr_t &x) { visit_expr(*x.m_arg); - s = "char(" + s + ")"; + src = "char(" + src + ")"; } void visit_StringFormat(const ASR::StringFormat_t &x) { std::string r = ""; if (format_string.size() > 0) { visit_expr(*x.m_fmt); - format_string = s; + format_string = src; } for (size_t i = 0; i < x.n_args; i++) { visit_expr(*x.m_args[i]); - r += s; + r += src; if (i < x.n_args-1) r += ", "; } - s = r; + src = r; } // void visit_CPtrCompare(const ASR::CPtrCompare_t &x) {} @@ -1430,45 +1563,57 @@ class ASRToFortranVisitor : public ASR::BaseVisitor // void visit_SymbolicCompare(const ASR::SymbolicCompare_t &x) {} void visit_Var(const ASR::Var_t &x) { - s = ASRUtils::symbol_name(x.m_v); + src = ASRUtils::symbol_name(x.m_v); last_expr_precedence = Precedence::Ext; } // void visit_FunctionParam(const ASR::FunctionParam_t &x) {} + void visit_ArrayConstructor(const ASR::ArrayConstructor_t &x) { + std::string r = "["; + for(size_t i = 0; i < x.n_args; i++) { + visit_expr(*x.m_args[i]); + r += src; + if (i < x.n_args-1) r += ", "; + } + r += "]"; + src = r; + last_expr_precedence = Precedence::Ext; + } + void visit_ArrayConstant(const ASR::ArrayConstant_t &x) { std::string r = "["; for(size_t i = 0; i < x.n_args; i++) { visit_expr(*x.m_args[i]); - r += s; + r += src; if (i < x.n_args-1) r += ", "; } r += "]"; - s = r; + src = r; last_expr_precedence = Precedence::Ext; } void visit_ArrayItem(const ASR::ArrayItem_t &x) { std::string r = ""; visit_expr(*x.m_v); - r += s; + r += src; r += "("; for(size_t i = 0; i < x.n_args; i++) { if (x.m_args[i].m_right) { visit_expr(*x.m_args[i].m_right); - r += s; + r += src; } if (i < x.n_args-1) r += ", "; } r += ")"; - s = r; + src = r; last_expr_precedence = Precedence::Ext; } void visit_ArraySection(const ASR::ArraySection_t &x) { std::string r = ""; visit_expr(*x.m_v); - r += s; + r += src; r += "("; for (size_t i = 0; i < x.n_args; i++) { if (i > 0) { @@ -1477,37 +1622,37 @@ class ASRToFortranVisitor : public ASR::BaseVisitor std::string left, right, step; if (x.m_args[i].m_left) { visit_expr(*x.m_args[i].m_left); - left = std::move(s); + left = std::move(src); r += left + ":"; } if (x.m_args[i].m_right) { visit_expr(*x.m_args[i].m_right); - right = std::move(s); + right = std::move(src); r += right; } if (x.m_args[i].m_step ) { visit_expr(*x.m_args[i].m_step); - step = std::move(s); + step = std::move(src); if (step != "1") { r += ":" + step; } } } r += ")"; - s = r; + src = r; last_expr_precedence = Precedence::Ext; } void visit_ArraySize(const ASR::ArraySize_t &x) { visit_expr(*x.m_v); - std::string r = "size(" + s; + std::string r = "size(" + src; if (x.m_dim) { r += ", "; visit_expr(*x.m_dim); - r += s; + r += src; } r += ")"; - s = r; + src = r; } void visit_ArrayBound(const ASR::ArrayBound_t &x) { @@ -1518,47 +1663,28 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "lbound("; } visit_expr(*x.m_v); - r += s; + r += src; r += ", "; visit_expr(*x.m_dim); - r += s; + r += src; r += ")"; - s = r; + src = r; } void visit_ArrayTranspose(const ASR::ArrayTranspose_t &x) { visit_expr(*x.m_matrix); - s = "transpose(" + s + ")"; - } - - void visit_ArrayPack(const ASR::ArrayPack_t &x) { - std::string r; - r += "pack"; - r += "("; - visit_expr(*x.m_array); - r += s; - r += ", "; - visit_expr(*x.m_mask); - r += s; - if (x.m_vector) { - r += ", "; - visit_expr(*x.m_vector); - r += s; - } - r += ")"; - s = r; + src = "transpose(" + src + ")"; } void visit_ArrayReshape(const ASR::ArrayReshape_t &x) { - std::string r; - r += "reshape("; + std::string r = "reshape("; visit_expr(*x.m_array); - r += s; + r += src; r += ", "; visit_expr(*x.m_shape); - r += s; + r += src; r += ")"; - s = r; + src = r; } void visit_ArrayAll(const ASR::ArrayAll_t &x) { @@ -1566,13 +1692,13 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "all"; r += "("; visit_expr(*x.m_mask); - r += s; + r += src; if (x.m_dim) { visit_expr(*x.m_dim); - r += s; + r += src; } r += ")"; - s = r; + src = r; } // void visit_BitCast(const ASR::BitCast_t &x) {} @@ -1580,10 +1706,10 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_StructInstanceMember(const ASR::StructInstanceMember_t &x) { std::string r; visit_expr(*x.m_v); - r += s; + r += src; r += "%"; r += ASRUtils::symbol_name(ASRUtils::symbol_get_past_external(x.m_m)); - s = r; + src = r; } // void visit_StructStaticMember(const ASR::StructStaticMember_t &x) {} @@ -1603,167 +1729,46 @@ class ASRToFortranVisitor : public ASR::BaseVisitor // void visit_OverloadedUnaryMinus(const ASR::OverloadedUnaryMinus_t &x) {} void visit_Cast(const ASR::Cast_t &x) { - std::string r; visit_expr(*x.m_arg); - switch (x.m_kind) { - case (ASR::cast_kindType::IntegerToReal) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 1: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 2: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 4: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast IntegerToReal: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::RealToInteger) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 1: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - case 2: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - case 4: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast RealToInteger: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::RealToReal) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 1: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 2: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 4: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast RealToReal: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::IntegerToInteger) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 1: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - case 2: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - case 4: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "int(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast IntegerToInteger: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::ComplexToComplex) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 4: r = "cmplx(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "cmplx(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast ComplexToComplex: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::IntegerToComplex) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 4: r = "cmplx(" + s + ", " + "0.0" + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "cmplx(" + s + ", " + "0.0" + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast IntegerToComplex: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::ComplexToReal) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 4: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast ComplexToReal: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::RealToComplex) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 4: r = "cmplx(" + s + ", " + "0.0" + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "cmplx(" + s + ", " + "0.0" + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast IntegerToComplex: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::LogicalToInteger) : { - s = "int(" + s + ")"; - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::LogicalToCharacter) : { - s = "char(" + s + ")"; - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::IntegerToLogical) : { - // Implicit conversion between integer -> logical - break; - } - case (ASR::cast_kindType::LogicalToReal) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 4: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: r = "real(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast LogicalToReal: Unsupported Kind " + std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::RealToLogical) : { - s = "(bool)(" + s + ")"; - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::CharacterToLogical) : { - s = "(bool)(len(" + s + ") > 0)"; - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::ComplexToLogical) : { - s = "(bool)(" + s + ")"; - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::IntegerToCharacter) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 1: s = "char(" + s + ", " + "kind=dest_kind" + ")"; break; - case 2: s = "char(" + s + ", " + "kind=dest_kind" + ")"; break; - case 4: s = "char(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: s = "char(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast IntegerToCharacter: Unsupported Kind " + \ - std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - case (ASR::cast_kindType::CharacterToInteger) : { - int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); - switch (dest_kind) { - case 1: s = "ichar(" + s + ", " + "kind=dest_kind" + ")"; break; - case 2: s = "ichar(" + s + ", " + "kind=dest_kind" + ")"; break; - case 4: s = "ichar(" + s + ", " + "kind=dest_kind" + ")"; break; - case 8: s = "ichar(" + s + ", " + "kind=dest_kind" + ")"; break; - default: throw CodeGenError("Cast CharacterToInteger: Unsupported Kind " + \ - std::to_string(dest_kind)); - } - last_expr_precedence = 2; - break; - } - default : { - throw CodeGenError("Cast kind " + std::to_string(x.m_kind) + " not implemented", - x.base.base.loc); + int dest_kind = ASRUtils::extract_kind_from_ttype_t(x.m_type); + std::string type_str; + + // If the cast is from Integer to Logical, do nothing + if (x.m_kind == ASR::cast_kindType::IntegerToLogical) { + // Implicit conversion between integer -> logical + return; + } + + // Mapping cast kinds to their corresponding Fortran type names and valid kinds + std::map>> cast_map = { + {ASR::cast_kindType::IntegerToReal, {"real", {1, 2, 4, 8}}}, + {ASR::cast_kindType::RealToInteger, {"int", {1, 2, 4, 8}}}, + {ASR::cast_kindType::RealToReal, {"real", {1, 2, 4, 8}}}, + {ASR::cast_kindType::IntegerToInteger, {"int", {1, 2, 4, 8}}}, + {ASR::cast_kindType::ComplexToComplex, {"cmplx", {4, 8}}}, + {ASR::cast_kindType::IntegerToComplex, {"cmplx", {4, 8}}}, + {ASR::cast_kindType::ComplexToReal, {"real", {4, 8}}}, + {ASR::cast_kindType::RealToComplex, {"cmplx", {4, 8}}}, + {ASR::cast_kindType::LogicalToInteger, {"int", {1, 2, 4, 8}}}, + }; + + if (cast_map.find(x.m_kind) != cast_map.end()) { + type_str = cast_map[x.m_kind].first; + auto &valid_kinds = cast_map[x.m_kind].second; + if (std::find(valid_kinds.begin(), valid_kinds.end(), dest_kind) == valid_kinds.end()) { + throw CodeGenError("Cast " + type_str + ": Unsupported Kind " + std::to_string(dest_kind)); } + } else { + throw CodeGenError("Cast kind " + std::to_string(x.m_kind) + " not implemented", x.base.base.loc); } + + // Construct the string based on the type, with special handling for ComplexToComplex + if (x.m_kind == ASR::cast_kindType::ComplexToComplex) { + src = "cmplx(" + src + ", kind=" + std::to_string(dest_kind) + ")"; + } else { + src = type_str + "(" + src + ((type_str == "cmplx") ? ", 0.0" : "") + ", kind=" + std::to_string(dest_kind) + ")"; + } + last_expr_precedence = Precedence::Ext; } void visit_ArrayBroadcast(const ASR::ArrayBroadcast_t &x) { @@ -1777,12 +1782,12 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_ComplexRe(const ASR::ComplexRe_t &x) { visit_expr(*x.m_arg); - s = "real(" + s + ")"; + src = "real(" + src + ")"; } void visit_ComplexIm(const ASR::ComplexIm_t &x) { visit_expr(*x.m_arg); - s = "aimag(" + s + ")"; + src = "aimag(" + src + ")"; } // void visit_CLoc(const ASR::CLoc_t &x) {} @@ -1793,17 +1798,17 @@ class ASRToFortranVisitor : public ASR::BaseVisitor void visit_IntegerBitLen(const ASR::IntegerBitLen_t &x) { visit_expr(*x.m_a); - s = "bit_size(" + s + ")"; + src = "bit_size(" + src + ")"; } void visit_Ichar(const ASR::Ichar_t &x) { visit_expr(*x.m_arg); - s = "ichar(" + s + ")"; + src = "ichar(" + src + ")"; } void visit_Iachar(const ASR::Iachar_t &x) { visit_expr(*x.m_arg); - s = "iachar(" + s + ")"; + src = "iachar(" + src + ")"; } // void visit_SizeOfType(const ASR::SizeOfType_t &x) {} @@ -1812,9 +1817,9 @@ class ASRToFortranVisitor : public ASR::BaseVisitor // void visit_PointerAssociated(const ASR::PointerAssociated_t &x) {} - void visit_IntrinsicFunctionSqrt(const ASR::IntrinsicFunctionSqrt_t &x) { + void visit_RealSqrt(const ASR::RealSqrt_t &x) { visit_expr(*x.m_arg); - s = "sqrt(" + s + ")"; + src = "sqrt(" + src + ")"; } /******************************* Case Stmt ********************************/ @@ -1823,17 +1828,17 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "case ("; for(size_t i = 0; i < x.n_test; i ++) { visit_expr(*x.m_test[i]); - r += s; + r += src; if (i < x.n_test-1) r += ", "; } r += ")\n"; inc_indent(); for(size_t i = 0; i < x.n_body; i ++) { visit_stmt(*x.m_body[i]); - r += s; + r += src; } dec_indent(); - s = r; + src = r; } void visit_CaseStmt_Range(const ASR::CaseStmt_Range_t &x) { @@ -1841,21 +1846,21 @@ class ASRToFortranVisitor : public ASR::BaseVisitor r += "case ("; if (x.m_start) { visit_expr(*x.m_start); - r += s; + r += src; } r += ":"; if (x.m_end) { visit_expr(*x.m_end); - r += s; + r += src; } r += ")\n"; inc_indent(); for(size_t i = 0; i < x.n_body; i ++) { visit_stmt(*x.m_body[i]); - r += s; + r += src; } dec_indent(); - s = r; + src = r; } }; @@ -1869,7 +1874,7 @@ Result asr_to_fortran(ASR::TranslationUnit_t &asr, diagnostics.diagnostics.push_back(e.d); return Error(); } - return v.s; + return v.src; } } // namespace LCompilers diff --git a/src/libasr/codegen/asr_to_julia.cpp b/src/libasr/codegen/asr_to_julia.cpp index 4bfadcd..588d4b5 100644 --- a/src/libasr/codegen/asr_to_julia.cpp +++ b/src/libasr/codegen/asr_to_julia.cpp @@ -1173,7 +1173,7 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor src += indent + "exit(1)\n"; } - void visit_IntrinsicFunctionSqrt(const ASR::IntrinsicFunctionSqrt_t &x) { + void visit_RealSqrt(const ASR::RealSqrt_t &x) { /* if (x.m_value) { this->visit_expr(*x.m_value); @@ -1237,7 +1237,7 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor void visit_DoConcurrentLoop(const ASR::DoConcurrentLoop_t& x) { - const ASR::DoLoop_t do_loop = ASR::DoLoop_t{ x.base, nullptr, x.m_head, x.m_body, x.n_body }; + const ASR::DoLoop_t do_loop = ASR::DoLoop_t{ x.base, nullptr, x.m_head, x.m_body, x.n_body, nullptr, 0 }; visit_DoLoop(do_loop, true); } @@ -1881,7 +1881,7 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor src = out; } - void visit_IntrinsicScalarFunction(const ASR::IntrinsicScalarFunction_t &x) { + void visit_IntrinsicElementalFunction(const ASR::IntrinsicElementalFunction_t &x) { std::string out; LCOMPILERS_ASSERT(x.n_args == 1); visit_expr(*x.m_args[0]); @@ -1901,6 +1901,10 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor SET_INTRINSIC_NAME(Expm1, "expm1"); SET_INTRINSIC_NAME(Trunc, "trunc"); SET_INTRINSIC_NAME(Fix, "fix"); + SET_INTRINSIC_NAME(Kind, "kind"); + SET_INTRINSIC_NAME(StringContainsSet, "verify"); + SET_INTRINSIC_NAME(StringFindSet, "scan"); + SET_INTRINSIC_NAME(SubstrIndex, "index"); default : { throw LCompilersException("IntrinsicFunction: `" + ASRUtils::get_intrinsic_name(x.m_intrinsic_id) diff --git a/src/libasr/codegen/asr_to_llvm.cpp b/src/libasr/codegen/asr_to_llvm.cpp index 4434ff1..4f9f34d 100644 --- a/src/libasr/codegen/asr_to_llvm.cpp +++ b/src/libasr/codegen/asr_to_llvm.cpp @@ -63,6 +63,7 @@ using ASRUtils::intent_local; using ASRUtils::intent_return_var; using ASRUtils::determine_module_dependencies; using ASRUtils::is_arg_dummy; +using ASRUtils::is_argument_of_type_CPtr; void string_init(llvm::LLVMContext &context, llvm::Module &module, llvm::IRBuilder<> &builder, llvm::Value* arg_size, llvm::Value* arg_string) { @@ -88,9 +89,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor std::string current_der_type_name; //! Helpful for debugging while testing LLVM code - void print_util(llvm::Value* v, std::string fmt_chars, std::string endline="\t") { + void print_util(llvm::Value* v, std::string fmt_chars, std::string endline) { // Usage: - // print_util(tmp, "%d") // `tmp` to be an integer type + // print_util(tmp, "%d", "\n") // `tmp` is an integer type to match the format specifiers std::vector args; std::vector fmt; args.push_back(v); @@ -1023,30 +1024,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor visit_AllocateUtil(x, x.m_stat, false); } - void visit_ListReserve(const ASR::ListReserve_t& x) { - ASR::ttype_t* el_type = ASRUtils::get_contained_type( - ASRUtils::expr_type(x.m_a)); - int64_t ptr_loads_copy = ptr_loads; - ptr_loads = 0; - this->visit_expr(*x.m_a); - llvm::Value* plist = tmp; - - ptr_loads = 1; - this->visit_expr_wrapper(x.m_size, true); - ptr_loads = ptr_loads_copy; - llvm::Value *pos = tmp; - - llvm::Value* list_data_ptr = list_api->get_pointer_to_list_data(plist); - llvm::Value* size = list_api->len(plist); - llvm::DataLayout data_layout(module.get()); - llvm::Type* llvm_el_type = llvm_utils->get_type_from_ttype_t_util(el_type, module.get()); - size_t el_struct_size = data_layout.getTypeAllocSize(llvm_el_type); - size = builder->CreateMul(size, llvm::ConstantInt::get( - llvm::Type::getInt32Ty(context), llvm::APInt(32, el_struct_size))); - llvm::Value* alloc_ptr = LLVM::lfortran_malloc(context, *module, *builder, size); - builder->CreateStore(builder->CreateBitCast(alloc_ptr, llvm_el_type->getPointerTo()), list_data_ptr); - } - void visit_ReAlloc(const ASR::ReAlloc_t& x) { LCOMPILERS_ASSERT(x.n_args == 1); handle_allocated(x.m_args[0].m_a); @@ -1269,8 +1246,12 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Value* const_list = builder->CreateAlloca(const_list_type, nullptr, "const_list"); list_api->list_init(type_code, const_list, *module, x.n_args, x.n_args); int64_t ptr_loads_copy = ptr_loads; - ptr_loads = 1; for( size_t i = 0; i < x.n_args; i++ ) { + if (is_argument_of_type_CPtr(x.m_args[i])) { + ptr_loads = 0; + } else { + ptr_loads = 1; + } this->visit_expr(*x.m_args[i]); llvm::Value* item = tmp; llvm::Value* pos = llvm::ConstantInt::get(context, llvm::APInt(32, i)); @@ -1387,7 +1368,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor this->visit_expr_wrapper(x.m_value, true); return; } - this->visit_expr(*x.m_arg); + this->visit_expr_wrapper(x.m_arg, true); llvm::Value *c = tmp; std::string runtime_func_name = "_lfortran_ichar"; llvm::Function *fn = module->getFunction(runtime_func_name); @@ -1474,7 +1455,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor tmp = builder->CreateCall(fn, {mask, size}); } - void visit_IntrinsicFunctionSqrt(const ASR::IntrinsicFunctionSqrt_t &x) { + void visit_RealSqrt(const ASR::RealSqrt_t &x) { if (x.m_value) { this->visit_expr_wrapper(x.m_value, true); return; @@ -1749,7 +1730,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } void visit_ListCount(const ASR::ListCount_t& x) { - ASR::ttype_t* asr_el_type = ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_arg)); + ASR::ttype_t *asr_el_type = ASRUtils::get_contained_type(ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_arg))); int64_t ptr_loads_copy = ptr_loads; ptr_loads = 0; this->visit_expr(*x.m_arg); @@ -1764,7 +1745,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor void generate_ListIndex(ASR::expr_t* m_arg, ASR::expr_t* m_ele, ASR::expr_t* m_start=nullptr, ASR::expr_t* m_end=nullptr) { - ASR::ttype_t* asr_el_type = ASRUtils::get_contained_type(ASRUtils::expr_type(m_arg)); + ASR::ttype_t *asr_el_type = ASRUtils::get_contained_type(ASRUtils::type_get_past_const(ASRUtils::expr_type(m_arg))); int64_t ptr_loads_copy = ptr_loads; ptr_loads = 0; this->visit_expr(*m_arg); @@ -1849,7 +1830,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor tmp = list_api->pop_position(plist, pos, asr_el_type, module.get(), name2memidx); } - void generate_Reserve(ASR::expr_t* m_arg, ASR::expr_t* m_ele) { + void generate_ListReserve(ASR::expr_t* m_arg, ASR::expr_t* m_ele) { // For now, this only handles lists ASR::ttype_t* asr_el_type = ASRUtils::get_contained_type(ASRUtils::expr_type(m_arg)); int64_t ptr_loads_copy = ptr_loads; @@ -1941,13 +1922,13 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm_utils->set_api->remove_item(pset, el, *module, asr_el_type); } - void visit_IntrinsicScalarFunction(const ASR::IntrinsicScalarFunction_t& x) { + void visit_IntrinsicElementalFunction(const ASR::IntrinsicElementalFunction_t& x) { if (x.m_value) { this->visit_expr_wrapper(x.m_value, true); return; } - switch (static_cast(x.m_intrinsic_id)) { - case ASRUtils::IntrinsicScalarFunctions::ListIndex: { + switch (static_cast(x.m_intrinsic_id)) { + case ASRUtils::IntrinsicElementalFunctions::ListIndex: { ASR::expr_t* m_arg = x.m_args[0]; ASR::expr_t* m_ele = x.m_args[1]; ASR::expr_t* m_start = nullptr; @@ -1973,11 +1954,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor generate_ListIndex(m_arg, m_ele, m_start, m_end); break ; } - case ASRUtils::IntrinsicScalarFunctions::ListReverse: { + case ASRUtils::IntrinsicElementalFunctions::ListReverse: { generate_ListReverse(x.m_args[0]); break; } - case ASRUtils::IntrinsicScalarFunctions::ListPop: { + case ASRUtils::IntrinsicElementalFunctions::ListPop: { switch(x.m_overload_id) { case 0: generate_ListPop_0(x.m_args[0]); @@ -1988,27 +1969,27 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } break; } - case ASRUtils::IntrinsicScalarFunctions::Reserve: { - generate_Reserve(x.m_args[0], x.m_args[1]); + case ASRUtils::IntrinsicElementalFunctions::ListReserve: { + generate_ListReserve(x.m_args[0], x.m_args[1]); break; } - case ASRUtils::IntrinsicScalarFunctions::DictKeys: { + case ASRUtils::IntrinsicElementalFunctions::DictKeys: { generate_DictElems(x.m_args[0], 0); break; } - case ASRUtils::IntrinsicScalarFunctions::DictValues: { + case ASRUtils::IntrinsicElementalFunctions::DictValues: { generate_DictElems(x.m_args[0], 1); break; } - case ASRUtils::IntrinsicScalarFunctions::SetAdd: { + case ASRUtils::IntrinsicElementalFunctions::SetAdd: { generate_SetAdd(x.m_args[0], x.m_args[1]); break; } - case ASRUtils::IntrinsicScalarFunctions::SetRemove: { + case ASRUtils::IntrinsicElementalFunctions::SetRemove: { generate_SetRemove(x.m_args[0], x.m_args[1]); break; } - case ASRUtils::IntrinsicScalarFunctions::Exp: { + case ASRUtils::IntrinsicElementalFunctions::Exp: { switch (x.m_overload_id) { case 0: { ASR::expr_t* m_arg = x.m_args[0]; @@ -2022,7 +2003,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } break ; } - case ASRUtils::IntrinsicScalarFunctions::Exp2: { + case ASRUtils::IntrinsicElementalFunctions::Exp2: { switch (x.m_overload_id) { case 0: { ASR::expr_t* m_arg = x.m_args[0]; @@ -2036,7 +2017,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } break ; } - case ASRUtils::IntrinsicScalarFunctions::Expm1: { + case ASRUtils::IntrinsicElementalFunctions::Expm1: { switch (x.m_overload_id) { case 0: { ASR::expr_t* m_arg = x.m_args[0]; @@ -2050,7 +2031,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } break ; } - case ASRUtils::IntrinsicScalarFunctions::FlipSign: { + case ASRUtils::IntrinsicElementalFunctions::FlipSign: { Vec args; args.reserve(al, 2); ASR::call_arg_t arg0_, arg1_; @@ -2061,7 +2042,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor generate_flip_sign(args.p); break; } - case ASRUtils::IntrinsicScalarFunctions::FMA: { + case ASRUtils::IntrinsicElementalFunctions::FMA: { Vec args; args.reserve(al, 3); ASR::call_arg_t arg0_, arg1_, arg2_; @@ -2074,7 +2055,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor generate_fma(args.p); break; } - case ASRUtils::IntrinsicScalarFunctions::SignFromValue: { + case ASRUtils::IntrinsicElementalFunctions::SignFromValue: { Vec args; args.reserve(al, 2); ASR::call_arg_t arg0_, arg1_; @@ -2086,7 +2067,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor break; } default: { - throw CodeGenError("Either the '" + ASRUtils::IntrinsicScalarFunctionRegistry:: + throw CodeGenError("Either the '" + ASRUtils::IntrinsicElementalFunctionRegistry:: get_intrinsic_function_name(x.m_intrinsic_id) + "' intrinsic is not implemented by LLVM backend or " "the compile-time value is not available", x.base.base.loc); @@ -2106,6 +2087,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor // until then, this returns `False` tmp = llvm::ConstantInt::get(context, llvm::APInt(1, 0)); break ; + } case ASRUtils::IntrinsicImpureFunctions::Allocated : { + handle_allocated(x.m_args[0]); + break ; } default: { throw CodeGenError( ASRUtils::get_impure_intrinsic_name(x.m_impure_intrinsic_id) + " is not implemented by LLVM backend.", x.base.base.loc); @@ -2113,6 +2097,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } + void visit_TypeInquiry(const ASR::TypeInquiry_t &x) { + this->visit_expr(*x.m_value); + } + void visit_ListClear(const ASR::ListClear_t& x) { int64_t ptr_loads_copy = ptr_loads; ptr_loads = 0; @@ -2345,7 +2333,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor Vec llvm_diminfo; llvm_diminfo.reserve(al, 2 * x.n_args + 1); if( array_t->m_physical_type == ASR::array_physical_typeType::PointerToDataArray || - array_t->m_physical_type == ASR::array_physical_typeType::FixedSizeArray ) { + array_t->m_physical_type == ASR::array_physical_typeType::FixedSizeArray || + array_t->m_physical_type == ASR::array_physical_typeType::SIMDArray || + (array_t->m_physical_type == ASR::array_physical_typeType::CharacterArraySinglePointer && ASRUtils::is_fixed_size_array(x_mv_type)) ) { int ptr_loads_copy = ptr_loads; for( size_t idim = 0; idim < x.n_args; idim++ ) { ptr_loads = 2 - !LLVM::is_llvm_pointer(*ASRUtils::expr_type(m_dims[idim].m_start)); @@ -2379,7 +2369,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } else { tmp = arr_descr->get_single_element(array, indices, x.n_args, array_t->m_physical_type == ASR::array_physical_typeType::PointerToDataArray, - array_t->m_physical_type == ASR::array_physical_typeType::FixedSizeArray, + array_t->m_physical_type == ASR::array_physical_typeType::FixedSizeArray || array_t->m_physical_type == ASR::array_physical_typeType::SIMDArray + || (array_t->m_physical_type == ASR::array_physical_typeType::CharacterArraySinglePointer && ASRUtils::is_fixed_size_array(x_mv_type)), llvm_diminfo.p, is_polymorphic, current_select_type_block_type); } } @@ -2693,6 +2684,15 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } llvm_symtab[h] = ptr; + } else if (x.m_type->type == ASR::ttypeType::Array) { + // Using approach same as ASR::ttypeType::List + llvm::StructType* array_type = static_cast( + llvm_utils->get_type_from_ttype_t_util(x.m_type, module.get())); + llvm::Constant *ptr = module->getOrInsertGlobal(x.m_name, array_type); + module->getNamedGlobal(x.m_name)->setInitializer( + llvm::ConstantStruct::get(array_type, + llvm::Constant::getNullValue(array_type))); + llvm_symtab[h] = ptr; } else if (x.m_type->type == ASR::ttypeType::Logical) { llvm::Constant *ptr = module->getOrInsertGlobal(x.m_name, llvm::Type::getInt1Ty(context)); @@ -2822,6 +2822,14 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::ConstantStruct::get(dict_type, llvm::Constant::getNullValue(dict_type))); llvm_symtab[h] = ptr; + } else if(x.m_type->type == ASR::ttypeType::Set) { + llvm::StructType* set_type = static_cast( + llvm_utils->get_type_from_ttype_t_util(x.m_type, module.get())); + llvm::Constant *ptr = module->getOrInsertGlobal(x.m_name, set_type); + module->getNamedGlobal(x.m_name)->setInitializer( + llvm::ConstantStruct::get(set_type, + llvm::Constant::getNullValue(set_type))); + llvm_symtab[h] = ptr; } else if (x.m_type->type == ASR::ttypeType::TypeParameter) { // Ignore type variables } else { @@ -3045,11 +3053,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } builder->SetInsertPoint(BB); - // Call the `_lpython_set_argv` function to assign command line argument - // values to `argc` and `argv`. + // Call the `_lpython_call_initial_functions` function to assign command line argument + // values to `argc` and `argv`, and set the random seed to the system clock. { if (compiler_options.emit_debug_info) debug_emit_loc(x); - llvm::Function *fn = module->getFunction("_lpython_set_argv"); + llvm::Function *fn = module->getFunction("_lpython_call_initial_functions"); if(!fn) { llvm::FunctionType *function_type = llvm::FunctionType::get( llvm::Type::getVoidTy(context), { @@ -3057,7 +3065,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor character_type->getPointerTo() }, false); fn = llvm::Function::Create(function_type, - llvm::Function::ExternalLinkage, "_lpython_set_argv", *module); + llvm::Function::ExternalLinkage, "_lpython_call_initial_functions", *module); } std::vector args; for (llvm::Argument &llvm_arg : F->args()) { @@ -3192,8 +3200,12 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor size_t n_dims = ASRUtils::extract_dimensions_from_ttype(symbol_type, m_dims); ASR::array_physical_typeType phy_type = ASRUtils::extract_physical_type(symbol_type); bool is_data_only = (phy_type == ASR::array_physical_typeType::PointerToDataArray || - phy_type == ASR::array_physical_typeType::FixedSizeArray); - if (phy_type == ASR::array_physical_typeType::DescriptorArray) { + phy_type == ASR::array_physical_typeType::FixedSizeArray || + (phy_type == ASR::array_physical_typeType::CharacterArraySinglePointer && + ASRUtils::is_fixed_size_array(symbol_type))); + if (phy_type == ASR::array_physical_typeType::DescriptorArray || + (phy_type == ASR::array_physical_typeType::CharacterArraySinglePointer && + ASRUtils::is_dimension_empty(m_dims, n_dims))) { int n_dims = 0, a_kind=4; ASR::dimension_t* m_dims = nullptr; bool is_array_type = false; @@ -3234,8 +3246,22 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor LLVM::CreateStore(*builder, array_size_value, array_size); break; } + case ASR::array_physical_typeType::PointerToDataArray: { + ASR::dimension_t* m_dims = nullptr; + size_t n_dims = ASRUtils::extract_dimensions_from_ttype(v_m_type, m_dims); + llvm::Value* llvm_size = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), llvm::APInt(32, 1)); + int ptr_loads_copy = ptr_loads; + ptr_loads = 2; + for( size_t i = 0; i < n_dims; i++ ) { + visit_expr_wrapper(m_dims[i].m_length, true); + llvm_size = builder->CreateMul(tmp, llvm_size); + } + ptr_loads = ptr_loads_copy; + LLVM::CreateStore(*builder, llvm_size, array_size); + break; + } default: { - LCOMPILERS_ASSERT(false); + LCOMPILERS_ASSERT_MSG(false, std::to_string(phy_type)); } } llvm::Value* llvmi = CreateAlloca(llvm::Type::getInt32Ty(context), nullptr, "i"); @@ -3260,6 +3286,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor LLVM::CreateLoad(*builder, llvmi)); break; } + case ASR::array_physical_typeType::PointerToDataArray: { + ptr_i = llvm_utils->create_ptr_gep(ptr, LLVM::CreateLoad(*builder, llvmi)); + break; + } default: { LCOMPILERS_ASSERT(false); } @@ -3508,9 +3538,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } llvm_symtab[h] = ptr; - if( ASRUtils::is_array(v->m_type) && - ASRUtils::extract_physical_type(v->m_type) == - ASR::array_physical_typeType::DescriptorArray ) { + if( (ASRUtils::is_array(v->m_type) && + ((ASRUtils::extract_physical_type(v->m_type) == ASR::array_physical_typeType::DescriptorArray) || + (ASRUtils::extract_physical_type(v->m_type) == ASR::array_physical_typeType::CharacterArraySinglePointer && + ASRUtils::is_dimension_empty(m_dims,n_dims)))) + ) { fill_array_details_(ptr, type_, m_dims, n_dims, is_malloc_array_type, is_array_type, is_list, v->m_type); } @@ -3533,7 +3565,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } if( init_expr != nullptr && - !ASR::is_a(*v->m_type)) { + !is_list) { target_var = ptr; tmp = nullptr; if (v->m_value != nullptr) { @@ -3588,8 +3620,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor if (strlen == -3) { LCOMPILERS_ASSERT(t->m_len_expr) this->visit_expr(*t->m_len_expr); - arg_size = builder->CreateAdd(tmp, - llvm::ConstantInt::get(context, llvm::APInt(32, 1))); + arg_size = builder->CreateAdd(builder->CreateSExtOrTrunc(tmp, + llvm::Type::getInt32Ty(context)), + llvm::ConstantInt::get(context, llvm::APInt(32, 1)) ); } else { // Compile time length arg_size = llvm::ConstantInt::get(context, @@ -3606,10 +3639,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Value *init_value = llvm::Constant::getNullValue(type); builder->CreateStore(init_value, target_var); } else { - throw CodeGenError("Unsupported len value in ASR"); + throw CodeGenError("Unsupported len value in ASR " + std::to_string(strlen)); } } else if (is_list) { - ASR::List_t* asr_list = ASR::down_cast(v->m_type); + ASR::List_t* asr_list = ASR::down_cast(ASRUtils::type_get_past_const(v->m_type)); std::string type_code = ASRUtils::get_type_code(asr_list->m_type); list_api->list_init(type_code, ptr, *module); } @@ -3627,6 +3660,13 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } + bool is_function_variable(const ASR::symbol_t *v) { + if( !ASR::is_a(*v) ) { + return false; + } + return is_function_variable(*ASR::down_cast(v)); + } + // F is the function that we are generating and we go over all arguments // (F.args()) and handle three cases: // * Variable (`integer :: x`) @@ -3637,6 +3677,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor for (llvm::Argument &llvm_arg : F.args()) { ASR::symbol_t *s = symbol_get_past_external( ASR::down_cast(x.m_args[i])->m_v); + ASR::symbol_t* arg_sym = s; if (is_a(*s)) { ASR::Variable_t *v = ASR::down_cast(s); if (is_function_variable(*v)) { @@ -3656,10 +3697,13 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor // * Function (`fn`) // Deal with case where procedure passed in as argument ASR::Function_t *arg = ASR::down_cast(s); - uint32_t h = get_hash((ASR::asr_t*)arg); - std::string arg_s = arg->m_name; + uint32_t h = get_hash((ASR::asr_t*)arg_sym); + std::string arg_s = ASRUtils::symbol_name(arg_sym); llvm_arg.setName(arg_s); llvm_symtab_fn_arg[h] = &llvm_arg; + if( is_function_variable(arg_sym) ) { + llvm_symtab[h] = &llvm_arg; + } if (llvm_symtab_fn.find(h) == llvm_symtab_fn.end()) { llvm::FunctionType* fntype = llvm_utils->get_function_type(*arg, module.get()); llvm::Function* fn = llvm::Function::Create(fntype, llvm::Function::ExternalLinkage, arg->m_name, module.get()); @@ -4482,6 +4526,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor strings_to_be_deallocated.push_back(al, tmp); } + void visit_OverloadedStringConcat(const ASR::OverloadedStringConcat_t &x) { + LCOMPILERS_ASSERT(x.m_overloaded != nullptr) + this->visit_expr(*x.m_overloaded); + } + void visit_Assignment(const ASR::Assignment_t &x) { if (compiler_options.emit_debug_info) debug_emit_loc(x); if( x.m_overloaded ) { @@ -4724,11 +4773,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor ASR::ttype_t *cont_type = ASRUtils::get_contained_type(asr_target_type); if ( ASRUtils::is_array(cont_type) ) { if( is_value_list_to_array ) { - if( ASRUtils::extract_physical_type(asr_target_type) != - ASR::array_physical_typeType::DescriptorArray ) { - throw CodeGenError("ListToArray cast output can " - "only be assigned to a descriptor based array."); - } this->visit_expr_wrapper(x.m_value, true); llvm::Value* list_data = tmp; int64_t ptr_loads_copy = ptr_loads; @@ -4736,8 +4780,17 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor this->visit_expr(*ASR::down_cast(x.m_value)->m_arg); llvm::Value* plist = tmp; ptr_loads = ptr_loads_copy; - llvm::Value* array_data = LLVM::CreateLoad(*builder, - arr_descr->get_pointer_to_data(LLVM::CreateLoad(*builder, target))); + 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()); @@ -4759,10 +4812,14 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } ASR::ttype_t* target_type = ASRUtils::expr_type(x.m_target); ASR::ttype_t* value_type = ASRUtils::expr_type(x.m_value); + ASR::expr_t *m_value = x.m_value; + if (ASRUtils::is_simd_array(x.m_target) && ASR::is_a(*m_value)) { + m_value = ASR::down_cast(m_value)->m_v; + } int ptr_loads_copy = ptr_loads; ptr_loads = 2 - (ASRUtils::is_character(*value_type) || ASRUtils::is_array(value_type)); - this->visit_expr_wrapper(x.m_value, true); + this->visit_expr_wrapper(m_value, true); ptr_loads = ptr_loads_copy; if( ASR::is_a(*x.m_value) && ASR::is_a(*value_type) ) { @@ -4785,8 +4842,12 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor (ASR::is_a(*x.m_target) && ASRUtils::is_character(*target_type))) && !ASR::is_a(*x.m_target) ) { - builder->CreateStore(value, target); - strings_to_be_deallocated.erase(strings_to_be_deallocated.back()); + if( ASRUtils::is_allocatable(x.m_target) ) { + tmp = lfortran_str_copy(target, value, true); + } else { + builder->CreateStore(value, target); + strings_to_be_deallocated.erase(strings_to_be_deallocated.back()); + } return; } else if (ASR::is_a(*x.m_target)) { ASR::Variable_t *asr_target = EXPR2VAR(x.m_target); @@ -4806,6 +4867,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor bool is_value_data_only_array = (value_ptype == ASR::array_physical_typeType::PointerToDataArray); bool is_target_fixed_sized_array = (target_ptype == ASR::array_physical_typeType::FixedSizeArray); bool is_value_fixed_sized_array = (value_ptype == ASR::array_physical_typeType::FixedSizeArray); + bool is_target_simd_array = (target_ptype == ASR::array_physical_typeType::SIMDArray); bool is_target_descriptor_based_array = (target_ptype == ASR::array_physical_typeType::DescriptorArray); bool is_value_descriptor_based_array = (value_ptype == ASR::array_physical_typeType::DescriptorArray); if( is_value_fixed_sized_array && is_target_fixed_sized_array ) { @@ -4860,24 +4922,19 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor is_target_data_only_array = true; } llvm::Value *target_data = nullptr, *value_data = nullptr, *llvm_size = nullptr; + llvm_size = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), llvm::APInt(32, 1)); if( is_target_data_only_array ) { target_data = target; ASR::dimension_t* target_dims = nullptr; int target_ndims = ASRUtils::extract_dimensions_from_ttype(target_type, target_dims); - size_t target_size = 1; data_only_copy = true; for( int i = 0; i < target_ndims; i++ ) { - int dim_length = -1; - if( !ASRUtils::extract_value(ASRUtils::expr_value(target_dims[i].m_length), dim_length) ) { + if( target_dims[i].m_length == nullptr ) { data_only_copy = false; break; } - target_size *= dim_length; - } - if( data_only_copy ) { - llvm_size = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), - llvm::APInt(32, target_size)); - data_only_copy = false; + this->visit_expr_wrapper(target_dims[i].m_length, true); + llvm_size = builder->CreateMul(llvm_size, tmp); } } else { target_data = LLVM::CreateLoad(*builder, arr_descr->get_pointer_to_data(target)); @@ -4886,31 +4943,48 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor value_data = value; ASR::dimension_t* value_dims = nullptr; int value_ndims = ASRUtils::extract_dimensions_from_ttype(value_type, value_dims); - size_t value_size = 1; - data_only_copy = true; - for( int i = 0; i < value_ndims; i++ ) { - int dim_length = -1; - if( !ASRUtils::extract_value(ASRUtils::expr_value(value_dims[i].m_length), dim_length) ) { - data_only_copy = false; - break; + if( !data_only_copy ) { + llvm_size = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), llvm::APInt(32, 1)); + data_only_copy = true; + for( int i = 0; i < value_ndims; i++ ) { + if( value_dims[i].m_length == nullptr ) { + data_only_copy = false; + break; + } + this->visit_expr_wrapper(value_dims[i].m_length, true); + llvm_size = builder->CreateMul(llvm_size, tmp); } - value_size *= dim_length; - } - if( data_only_copy ) { - llvm_size = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), - llvm::APInt(32, value_size)); - data_only_copy = false; } } else { value_data = LLVM::CreateLoad(*builder, arr_descr->get_pointer_to_data(value)); } - if( llvm_size ) { - llvm::Type* llvm_data_type = llvm_utils->get_type_from_ttype_t_util( - ASRUtils::type_get_past_allocatable( - ASRUtils::type_get_past_pointer( - ASRUtils::type_get_past_array(target_type))), module.get()); - arr_descr->copy_array_data_only(value_data, target_data, module.get(), - llvm_data_type, llvm_size); + LCOMPILERS_ASSERT(data_only_copy); + llvm::Type* llvm_data_type = llvm_utils->get_type_from_ttype_t_util( + ASRUtils::type_get_past_allocatable( + ASRUtils::type_get_past_pointer( + ASRUtils::type_get_past_array(target_type))), module.get()); + arr_descr->copy_array_data_only(value_data, target_data, module.get(), + llvm_data_type, llvm_size); + } else if ( is_target_simd_array ) { + if (ASR::is_a(*x.m_value)) { + int idx = 1; + ASR::ArraySection_t *arr = down_cast(x.m_value); + (void) ASRUtils::extract_value(arr->m_args->m_left, idx); + value = llvm_utils->create_gep(value, idx-1); + target = llvm_utils->create_gep(target, 0); + ASR::dimension_t* asr_dims = nullptr; + size_t asr_n_dims = ASRUtils::extract_dimensions_from_ttype(target_type, asr_dims); + int64_t size = ASRUtils::get_fixed_size_of_array(asr_dims, asr_n_dims); + llvm::Type* llvm_data_type = llvm_utils->get_type_from_ttype_t_util(ASRUtils::type_get_past_array( + ASRUtils::type_get_past_allocatable(ASRUtils::type_get_past_pointer(target_type))), module.get()); + llvm::DataLayout data_layout(module.get()); + uint64_t data_size = data_layout.getTypeAllocSize(llvm_data_type); + llvm::Value* llvm_size = llvm::ConstantInt::get(context, llvm::APInt(32, size)); + llvm_size = builder->CreateMul(llvm_size, + llvm::ConstantInt::get(context, llvm::APInt(32, data_size))); + builder->CreateMemCpy(target, llvm::MaybeAlign(), value, llvm::MaybeAlign(), llvm_size); + } else { + builder->CreateStore(value, target); } } else { bool create_dim_des_array = false; @@ -4919,7 +4993,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor create_dim_des_array = true; } arr_descr->copy_array(value, target, module.get(), - target_type, create_dim_des_array, false); + target_type, create_dim_des_array, false); } } else if( ASR::is_a(*x.m_target) ) { ASR::DictItem_t* dict_item_t = ASR::down_cast(x.m_target); @@ -4947,6 +5021,30 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } + void PointerToData_to_Descriptor(ASR::ttype_t* m_type, ASR::ttype_t* m_type_for_dimensions) { + llvm::BasicBlock &entry_block = builder->GetInsertBlock()->getParent()->getEntryBlock(); + llvm::IRBuilder<> builder0(context); + builder0.SetInsertPoint(&entry_block, entry_block.getFirstInsertionPt()); + llvm::Type* target_type = llvm_utils->get_type_from_ttype_t_util( + ASRUtils::type_get_past_allocatable( + ASRUtils::type_get_past_pointer(m_type)), module.get()); + llvm::AllocaInst *target = builder0.CreateAlloca( + target_type, nullptr, "array_descriptor"); + builder->CreateStore(tmp, arr_descr->get_pointer_to_data(target)); + ASR::dimension_t* m_dims = nullptr; + int n_dims = ASRUtils::extract_dimensions_from_ttype(m_type_for_dimensions, m_dims); + llvm::Type* llvm_data_type = llvm_utils->get_type_from_ttype_t_util( + ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(m_type)), module.get()); + fill_array_details(target, llvm_data_type, m_dims, n_dims, false, false); + if( LLVM::is_llvm_pointer(*m_type) ) { + llvm::AllocaInst* target_ptr = builder0.CreateAlloca( + target_type->getPointerTo(), nullptr, "array_descriptor_ptr"); + builder->CreateStore(target, target_ptr); + target = target_ptr; + } + tmp = target; + } + void visit_ArrayPhysicalCastUtil(llvm::Value* arg, ASR::expr_t* m_arg, ASR::ttype_t* m_type, ASR::ttype_t* m_type_for_dimensions, ASR::array_physical_typeType m_old, ASR::array_physical_typeType m_new) { @@ -4956,29 +5054,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor return ; } - #define PointerToData_to_Descriptor() llvm::BasicBlock &entry_block = builder->GetInsertBlock()->getParent()->getEntryBlock(); \ - llvm::IRBuilder<> builder0(context); \ - builder0.SetInsertPoint(&entry_block, entry_block.getFirstInsertionPt()); \ - llvm::Type* target_type = llvm_utils->get_type_from_ttype_t_util( \ - ASRUtils::type_get_past_allocatable( \ - ASRUtils::type_get_past_pointer(m_type)), module.get()); \ - llvm::AllocaInst *target = builder0.CreateAlloca( \ - target_type, nullptr, "array_descriptor"); \ - builder->CreateStore(tmp, arr_descr->get_pointer_to_data(target)); \ - ASR::dimension_t* m_dims = nullptr; \ - int n_dims = ASRUtils::extract_dimensions_from_ttype(m_type_for_dimensions, m_dims); \ - llvm::Type* llvm_data_type = llvm_utils->get_type_from_ttype_t_util( \ - ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(m_type)), module.get()); \ - fill_array_details(target, llvm_data_type, m_dims, n_dims, false, false); \ - if( LLVM::is_llvm_pointer(*m_type) ) { \ - llvm::AllocaInst* target_ptr = builder0.CreateAlloca( \ - target_type->getPointerTo(), nullptr, "array_descriptor_ptr"); \ - builder->CreateStore(target, target_ptr); \ - target = target_ptr; \ - } \ - tmp = target; \ - - if( m_new == ASR::array_physical_typeType::PointerToDataArray && m_old == ASR::array_physical_typeType::DescriptorArray ) { if( ASR::is_a(*m_arg) ) { @@ -4989,32 +5064,43 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } 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(*ASRUtils::expr_value(m_arg))) || - ASRUtils::expr_value(m_arg) == nullptr ) { + ASRUtils::expr_value(m_arg) == nullptr ) && + !ASR::is_a(*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(*ASRUtils::expr_value(m_arg))) || - ASRUtils::expr_value(m_arg) == nullptr ) { + ASRUtils::expr_value(m_arg) == nullptr) && + !ASR::is_a(*m_arg) ) { tmp = llvm_utils->create_gep(tmp, 0); } + } else if ( + m_new == ASR::array_physical_typeType::SIMDArray && + m_old == ASR::array_physical_typeType::FixedSizeArray) { + // pass + } else if ( + m_new == ASR::array_physical_typeType::DescriptorArray && + m_old == ASR::array_physical_typeType::SIMDArray) { + tmp = CreateLoad(arg); } 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(*ASRUtils::expr_value(m_arg))) || - ASRUtils::expr_value(m_arg) == nullptr ) { + ASRUtils::expr_value(m_arg) == nullptr) && + !ASR::is_a(*m_arg) ) { tmp = llvm_utils->create_gep(tmp, 0); } - PointerToData_to_Descriptor() + PointerToData_to_Descriptor(m_type, m_type_for_dimensions); } else if( m_new == ASR::array_physical_typeType::DescriptorArray && m_old == ASR::array_physical_typeType::PointerToDataArray) { - PointerToData_to_Descriptor() + PointerToData_to_Descriptor(m_type, m_type_for_dimensions); } else if( m_new == ASR::array_physical_typeType::FixedSizeArray && m_old == ASR::array_physical_typeType::DescriptorArray) { @@ -5040,6 +5126,30 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor int n_dims = ASRUtils::extract_n_dims_from_ttype(m_type_for_dimensions); arr_descr->reset_array_details(target, tmp, n_dims); tmp = target; + } else if ( + m_new == ASR::array_physical_typeType::PointerToDataArray && + m_old == ASR::array_physical_typeType::CharacterArraySinglePointer) { + // + if (ASRUtils::is_fixed_size_array(m_type)) { + if( ((ASRUtils::expr_value(m_arg) && + !ASR::is_a(*ASRUtils::expr_value(m_arg))) || + ASRUtils::expr_value(m_arg) == nullptr) && + !ASR::is_a(*m_arg) ) { + tmp = llvm_utils->create_gep(tmp, 0); + } + } else { + tmp = LLVM::CreateLoad(*builder, arr_descr->get_pointer_to_data(tmp)); + } + } else if ( + m_new == ASR::array_physical_typeType::CharacterArraySinglePointer && + m_old == ASR::array_physical_typeType::DescriptorArray) { + if (ASRUtils::is_fixed_size_array(m_type)) { + tmp = LLVM::CreateLoad(*builder, arr_descr->get_pointer_to_data(tmp)); + llvm::Type* target_type = llvm_utils->get_type_from_ttype_t_util(m_type, module.get())->getPointerTo(); + tmp = builder->CreateBitCast(tmp, target_type); // [1 x i8*]* + // we need [1 x i8*] + tmp = LLVM::CreateLoad(*builder, tmp); + } } else { LCOMPILERS_ASSERT(false); } @@ -5066,6 +5176,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } void visit_BlockCall(const ASR::BlockCall_t& x) { + std::vector heap_arrays_copy; + heap_arrays_copy = heap_arrays; + heap_arrays.clear(); if( x.m_label != -1 ) { if( llvm_goto_targets.find(x.m_label) == llvm_goto_targets.end() ) { llvm::BasicBlock *new_target = llvm::BasicBlock::Create(context, "goto_target"); @@ -5075,7 +5188,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } LCOMPILERS_ASSERT(ASR::is_a(*x.m_m)); ASR::Block_t* block = ASR::down_cast(x.m_m); - declare_vars(*block); std::string block_name; if (block->m_name) { block_name = std::string(block->m_name); @@ -5094,6 +5206,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor fn->getBasicBlockList().push_back(blockend); #endif builder->SetInsertPoint(blockstart); + declare_vars(*block); loop_or_block_end.push_back(blockend); loop_or_block_end_names.push_back(blockend_name); for (size_t i = 0; i < block->n_body; i++) { @@ -5103,6 +5216,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor loop_or_block_end_names.pop_back(); llvm::BasicBlock *last_bb = builder->GetInsertBlock(); llvm::Instruction *block_terminator = last_bb->getTerminator(); + for( auto& value: heap_arrays ) { + LLVM::lfortran_free(context, *module, *builder, value); + } + heap_arrays = heap_arrays_copy; if (block_terminator == nullptr) { // The previous block is not terminated --- terminate it by jumping // to blockend @@ -5451,13 +5568,15 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Value *real_res, *img_res; switch (x.m_op) { case (ASR::cmpopType::Eq) : { - real_res = builder->CreateFCmpUEQ(real_left, real_right); - img_res = builder->CreateFCmpUEQ(img_left, img_right); + real_res = builder->CreateFCmpOEQ(real_left, real_right); + img_res = builder->CreateFCmpOEQ(img_left, img_right); + tmp = builder->CreateAnd(real_res, img_res); break; } case (ASR::cmpopType::NotEq) : { - real_res = builder->CreateFCmpUNE(real_left, real_right); - img_res = builder->CreateFCmpUNE(img_left, img_right); + real_res = builder->CreateFCmpONE(real_left, real_right); + img_res = builder->CreateFCmpONE(img_left, img_right); + tmp = builder->CreateOr(real_res, img_res); break; } default : { @@ -5465,7 +5584,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor x.base.base.loc); } } - tmp = builder->CreateAnd(real_res, img_res); } void visit_StringCompare(const ASR::StringCompare_t &x) { @@ -5842,7 +5960,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::AllocaInst *parg = builder->CreateAlloca(character_type, nullptr); builder->CreateStore(tmp, parg); ASR::ttype_t* arg_type = ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_arg)); - tmp = lfortran_str_len(parg, ASRUtils::is_array(arg_type)); + tmp = builder->CreateSExtOrTrunc( + lfortran_str_len(parg, ASRUtils::is_array(arg_type)), + llvm_utils->get_type_from_ttype_t_util(x.m_type, module.get())); } void visit_StringOrd(const ASR::StringOrd_t &x) { @@ -5878,7 +5998,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor ptr_loads = ptr_loads_copy; llvm::Value *str = tmp; if( is_assignment_target ) { - idx = builder->CreateSub(idx, llvm::ConstantInt::get(context, llvm::APInt(32, 1))); + idx = builder->CreateSub(builder->CreateSExtOrTrunc(idx, llvm::Type::getInt32Ty(context)), + llvm::ConstantInt::get(context, llvm::APInt(32, 1))); std::vector idx_vec = {idx}; tmp = CreateGEP(str, idx_vec); } else { @@ -5967,7 +6088,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } template - void handle_SU_IntegerBinOp(const T &x) { + void handle_SU_IntegerBinOp(const T &x, bool signed_int) { if (x.m_value) { this->visit_expr_wrapper(x.m_value, true); return; @@ -5992,19 +6113,27 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor break; }; case ASR::binopType::Div: { - tmp = builder->CreateUDiv(left_val, right_val); + if (signed_int) { + tmp = builder->CreateSDiv(left_val, right_val); + } else { + tmp = builder->CreateUDiv(left_val, right_val); + } break; }; case ASR::binopType::Pow: { llvm::Type *type; int a_kind; a_kind = down_cast(ASRUtils::extract_type(x.m_type))->m_kind; - type = llvm_utils->getFPType(a_kind); + if( a_kind <= 4 ) { + type = llvm_utils->getFPType(4); + } else { + type = llvm_utils->getFPType(8); + } llvm::Value *fleft = builder->CreateSIToFP(left_val, type); llvm::Value *fright = builder->CreateSIToFP(right_val, type); - std::string func_name = a_kind == 4 ? "llvm.pow.f32" : "llvm.pow.f64"; + std::string func_name = a_kind <= 4 ? "llvm.pow.f32" : "llvm.pow.f64"; llvm::Function *fn_pow = module->getFunction(func_name); if (!fn_pow) { llvm::FunctionType *function_type = llvm::FunctionType::get( @@ -6042,11 +6171,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } void visit_IntegerBinOp(const ASR::IntegerBinOp_t &x) { - handle_SU_IntegerBinOp(x); + handle_SU_IntegerBinOp(x, true); } void visit_UnsignedIntegerBinOp(const ASR::UnsignedIntegerBinOp_t &x) { - handle_SU_IntegerBinOp(x); + handle_SU_IntegerBinOp(x, false); } void visit_RealBinOp(const ASR::RealBinOp_t &x) { @@ -6061,6 +6190,12 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Value *right_val = tmp; lookup_enum_value_for_nonints = false; LCOMPILERS_ASSERT(ASRUtils::is_real(*x.m_type)) + if (ASRUtils::is_simd_array(x.m_right) && is_a(*x.m_right)) { + right_val = CreateLoad(right_val); + } + if (ASRUtils::is_simd_array(x.m_left) && is_a(*x.m_left)) { + left_val = CreateLoad(left_val); + } switch (x.m_op) { case ASR::binopType::Add: { tmp = builder->CreateFAdd(left_val, right_val); @@ -6299,8 +6434,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } - void visit_ArrayConstant(const ASR::ArrayConstant_t &x) { - llvm::Type* el_type; + template + 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(*x_m_type)) { el_type = llvm_utils->getIntType(ASR::down_cast(x_m_type)->m_kind); @@ -6317,6 +6453,15 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor el_type = llvm::Type::getInt1Ty(context); } else if (ASR::is_a(*x_m_type)) { el_type = character_type; + } else if (ASR::is_a(*x_m_type)) { + int complex_kind = ASR::down_cast(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"); } @@ -6338,6 +6483,14 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor 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) { + visit_ArrayConstructorUtil(x); + } + void visit_Assert(const ASR::Assert_t &x) { if (compiler_options.emit_debug_info) debug_emit_loc(x); this->visit_expr_wrapper(x.m_test, true); @@ -6576,9 +6729,24 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } void visit_Var(const ASR::Var_t &x) { - ASR::Variable_t *v = ASR::down_cast( - symbol_get_past_external(x.m_v)); - fetch_var(v); + ASR::symbol_t* x_m_v = ASRUtils::symbol_get_past_external(x.m_v); + switch( x_m_v->type ) { + case ASR::symbolType::Variable: { + ASR::Variable_t *v = ASR::down_cast(x_m_v); + fetch_var(v); + return ; + } + case ASR::symbolType::Function: { + uint32_t h = get_hash((ASR::asr_t*)x_m_v); + if( llvm_symtab_fn.find(h) != llvm_symtab_fn.end() ) { + tmp = llvm_symtab_fn[h]; + } + return; + } + default: { + throw CodeGenError("Only function and variables supported so far"); + } + } } inline ASR::ttype_t* extract_ttype_t_from_expr(ASR::expr_t* expr) { @@ -6594,11 +6762,55 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor arg_kind = ASRUtils::extract_kind_from_ttype_t(curr_type); } + template + void handle_arr_for_complex_im_re(const T& t) { + int64_t ptr_loads_copy = ptr_loads; + ptr_loads = 2 - LLVM::is_llvm_pointer(*ASRUtils::expr_type(t.m_arg)); + this->visit_expr_wrapper(t.m_arg, false); + ptr_loads = ptr_loads_copy; + llvm::Value* des_complex_arr = tmp; + tmp = CreateLoad(arr_descr->get_pointer_to_data(des_complex_arr)); + int kind = ASRUtils::extract_kind_from_ttype_t(t.m_type); + llvm::Type* pointer_cast_type = nullptr; + if (kind == 4) { + pointer_cast_type = llvm::Type::getFloatPtrTy(context); + } else { + pointer_cast_type = llvm::Type::getDoublePtrTy(context); + } + tmp = builder->CreateBitCast(tmp, pointer_cast_type); + PointerToData_to_Descriptor(t.m_type, t.m_type); + llvm::Value* des_real_arr = tmp; + llvm::Value* arr_data = CreateLoad(arr_descr->get_pointer_to_data(des_complex_arr)); + tmp = builder->CreateBitCast(arr_data, pointer_cast_type); + builder->CreateStore(tmp, arr_descr->get_pointer_to_data(des_real_arr)); + if (std::is_same::value) { + llvm::Value* incremented_offset = builder->CreateAdd( + arr_descr->get_offset(des_real_arr, true), + llvm::ConstantInt::get(context, llvm::APInt(32, 1))); + builder->CreateStore(incremented_offset, arr_descr->get_offset(des_real_arr, false)); + } + int n_dims = ASRUtils::extract_n_dims_from_ttype(t.m_type); + llvm::Value* dim_des_real_arr = arr_descr->get_pointer_to_dimension_descriptor_array(des_real_arr, true); + for (int i = 0; i < n_dims; i++) { + llvm::Value* dim_idx = llvm::ConstantInt::get(context, llvm::APInt(32, i)); + llvm::Value* dim_des_real_arr_idx = arr_descr->get_pointer_to_dimension_descriptor(dim_des_real_arr, dim_idx); + llvm::Value* doubled_stride = builder->CreateMul( + arr_descr->get_stride(dim_des_real_arr_idx, true), + llvm::ConstantInt::get(context, llvm::APInt(32, 2))); + builder->CreateStore(doubled_stride, arr_descr->get_stride(dim_des_real_arr_idx, false)); + } + tmp = des_real_arr; + } + void visit_ComplexRe(const ASR::ComplexRe_t &x) { if (x.m_value) { this->visit_expr_wrapper(x.m_value, true); return; } + if (ASRUtils::is_array(x.m_type)) { + handle_arr_for_complex_im_re(x); + return; + } this->visit_expr_wrapper(x.m_arg, true); ASR::ttype_t* curr_type = extract_ttype_t_from_expr(x.m_arg); int arg_kind = ASRUtils::extract_kind_from_ttype_t(curr_type); @@ -6632,6 +6844,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor this->visit_expr_wrapper(x.m_value, true); return; } + if (ASRUtils::is_array(x.m_type)) { + handle_arr_for_complex_im_re(x); + return; + } ASR::ttype_t* curr_type = extract_ttype_t_from_expr(x.m_arg); int arg_kind = ASRUtils::extract_kind_from_ttype_t(curr_type); llvm::Function *fn = nullptr; @@ -6669,6 +6885,21 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor tmp = CreateLoad(result); } + void visit_BitCast(const ASR::BitCast_t& x) { + if (x.m_value) { + this->visit_expr_wrapper(x.m_value, true); + return; + } + + this->visit_expr_wrapper(x.m_source, true); + llvm::Value* source = tmp; + llvm::Type* source_type = llvm_utils->get_type_from_ttype_t_util(ASRUtils::expr_type(x.m_source), module.get()); + llvm::Value* source_ptr = CreateAlloca(source_type, nullptr, "bitcast_source"); + builder->CreateStore(source, source_ptr); + llvm::Type* target_llvm_type = llvm_utils->get_type_from_ttype_t_util(x.m_type, module.get())->getPointerTo(); + tmp = LLVM::CreateLoad(*builder, builder->CreateBitCast(source_ptr, target_llvm_type)); + } + void visit_Cast(const ASR::Cast_t &x) { if (x.m_value) { this->visit_expr_wrapper(x.m_value, true); @@ -7162,12 +7393,19 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } void visit_FileRead(const ASR::FileRead_t &x) { - llvm::Value *unit_val, *iostat; + if( x.m_overloaded ) { + this->visit_stmt(*x.m_overloaded); + return ; + } + + llvm::Value *unit_val, *iostat, *read_size; + bool is_string = false; if (x.m_unit == nullptr) { // Read from stdin unit_val = llvm::ConstantInt::get( llvm::Type::getInt32Ty(context), llvm::APInt(32, -1)); } else { + is_string = ASRUtils::is_character(*expr_type(x.m_unit)); this->visit_expr_wrapper(x.m_unit, true); unit_val = tmp; } @@ -7183,10 +7421,22 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Type::getInt32Ty(context), nullptr); } + if (x.m_size) { + int ptr_copy = ptr_loads; + ptr_loads = 0; + this->visit_expr_wrapper(x.m_size, false); + ptr_loads = ptr_copy; + read_size = tmp; + } else { + read_size = builder->CreateAlloca( + llvm::Type::getInt32Ty(context), nullptr); + } + if (x.m_fmt) { std::vector args; args.push_back(unit_val); args.push_back(iostat); + args.push_back(read_size); this->visit_expr_wrapper(x.m_fmt, true); args.push_back(tmp); args.push_back(llvm::ConstantInt::get(context, llvm::APInt(32, x.n_values))); @@ -7204,6 +7454,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Type::getVoidTy(context), { llvm::Type::getInt32Ty(context), llvm::Type::getInt32Ty(context)->getPointerTo(), + llvm::Type::getInt32Ty(context)->getPointerTo(), character_type, llvm::Type::getInt32Ty(context) }, true); @@ -7218,7 +7469,26 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor this->visit_expr(*x.m_values[i]); ptr_loads = ptr_copy; ASR::ttype_t* type = ASRUtils::expr_type(x.m_values[i]); - llvm::Function *fn = get_read_function(type); + llvm::Function *fn; + if (is_string) { + // TODO: Support multiple arguments and fmt + std::string runtime_func_name = "_lfortran_string_read"; + llvm::Function *fn = module->getFunction(runtime_func_name); + if (!fn) { + llvm::FunctionType *function_type = llvm::FunctionType::get( + llvm::Type::getVoidTy(context), { + character_type, character_type, + llvm::Type::getInt32Ty(context)->getPointerTo() + }, false); + fn = llvm::Function::Create(function_type, + llvm::Function::ExternalLinkage, runtime_func_name, *module); + } + llvm::Value *fmt = builder->CreateGlobalStringPtr("%d"); + builder->CreateCall(fn, {unit_val, fmt, tmp}); + return; + } else { + fn = get_read_function(type); + } if (ASRUtils::is_array(type)) { if (ASR::is_a(*type) || ASR::is_a(*type)) { @@ -7259,7 +7529,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Function::ExternalLinkage, runtime_func_name, *module); } - this->visit_expr_wrapper(x.m_unit, true); builder->CreateCall(fn, {unit_val, iostat}); } } @@ -7269,24 +7538,29 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Value *status = nullptr, *form = nullptr; this->visit_expr_wrapper(x.m_newunit, true); unit_val = tmp; + int ptr_copy = ptr_loads; if (x.m_filename) { - this->visit_expr_wrapper(x.m_filename, true); + ptr_loads = 1; + this->visit_expr_wrapper(x.m_filename); f_name = tmp; } else { f_name = llvm::Constant::getNullValue(character_type); } if (x.m_status) { - this->visit_expr_wrapper(x.m_status, true); + ptr_loads = 1; + this->visit_expr_wrapper(x.m_status); status = tmp; } else { status = llvm::Constant::getNullValue(character_type); } if (x.m_form) { - this->visit_expr_wrapper(x.m_form, true); + ptr_loads = 1; + this->visit_expr_wrapper(x.m_form); form = tmp; } else { form = llvm::Constant::getNullValue(character_type); } + ptr_loads = ptr_copy; std::string runtime_func_name = "_lfortran_open"; llvm::Function *fn = module->getFunction(runtime_func_name); if (!fn) { @@ -7424,6 +7698,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } void visit_FileWrite(const ASR::FileWrite_t &x) { + if( x.m_overloaded ) { + this->visit_stmt(*x.m_overloaded); + return ; + } + if (x.m_unit == nullptr) { handle_print(x); return; @@ -7434,6 +7713,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor llvm::Value *sep = nullptr; llvm::Value *end = nullptr; llvm::Value *unit = nullptr; + llvm::Value *iostat = nullptr; std::string runtime_func_name; bool is_string = ASRUtils::is_character(*expr_type(x.m_unit)); @@ -7453,6 +7733,17 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor ptr_loads = ptr_loads_copy; unit = tmp; + if (x.m_iostat) { + int ptr_copy = ptr_loads; + ptr_loads = 0; + this->visit_expr_wrapper(x.m_iostat, false); + ptr_loads = ptr_copy; + iostat = tmp; + } else { + iostat = builder->CreateAlloca( + llvm::Type::getInt32Ty(context), nullptr); + } + if (x.m_separator) { this->visit_expr_wrapper(x.m_separator, true); sep = tmp; @@ -7466,16 +7757,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor end = builder->CreateGlobalStringPtr("\n"); } size_t n_values = x.n_values; ASR::expr_t **m_values = x.m_values; - // TODO: Handle String Formatting - if (n_values > 0 && is_a(*m_values[0]) && is_string) { - n_values = down_cast(m_values[0])->n_args; - m_values = down_cast(m_values[0])->m_args; - } for (size_t i=0; i std::vector printf_args; printf_args.push_back(unit); + printf_args.push_back(iostat); printf_args.push_back(fmt_ptr); printf_args.insert(printf_args.end(), args.begin(), args.end()); llvm::Function *fn = module->getFunction(runtime_func_name); if (!fn) { + args_type.push_back(llvm::Type::getInt32PtrTy(context)); args_type.push_back(llvm::Type::getInt8PtrTy(context)); llvm::FunctionType *function_type = llvm::FunctionType::get( llvm::Type::getVoidTy(context), args_type, true); @@ -7677,13 +7961,17 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor template void handle_print(const T &x) { std::vector args; + args.push_back(nullptr); // reserve space for fmt_str std::vector fmt; llvm::Value *sep = nullptr; + llvm::Value *sep_no_space = nullptr; llvm::Value *end = nullptr; + bool global_sep_space = false; if (x.m_separator) { this->visit_expr_wrapper(x.m_separator, true); sep = tmp; } else { + global_sep_space = true; sep = builder->CreateGlobalStringPtr(" "); } if (x.m_end) { @@ -7695,7 +7983,14 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor for (size_t i=0; iCreateGlobalStringPtr(""); + args.push_back(sep_no_space); + } } compute_fmt_specifier_and_arg(fmt, args, x.m_values[i], x.base.base.loc); } @@ -7706,36 +8001,67 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor fmt_str += fmt[i]; } llvm::Value *fmt_ptr = builder->CreateGlobalStringPtr(fmt_str); - std::vector printf_args; - printf_args.push_back(fmt_ptr); - printf_args.insert(printf_args.end(), args.begin(), args.end()); - printf(context, *module, *builder, printf_args); + args[0] = fmt_ptr; + printf(context, *module, *builder, args); } - void visit_Stop(const ASR::Stop_t &x) { - if (compiler_options.emit_debug_info) debug_emit_loc(x); - llvm::Value *exit_code; - if (x.m_code && is_a(*ASRUtils::expr_type(x.m_code))) { - this->visit_expr(*x.m_code); + void construct_stop(llvm::Value* exit_code, std::string stop_msg, ASR::expr_t* stop_code, Location loc) { + std::string fmt_str; + std::vector fmt; + std::vector args; + args.push_back(nullptr); // reserve space for fmt_str + ASR::ttype_t *str_type_len_msg = ASRUtils::TYPE(ASR::make_Character_t( + al, loc, 1, stop_msg.size(), nullptr)); + ASR::expr_t* STOP_MSG = ASRUtils::EXPR(ASR::make_StringConstant_t(al, loc, + s2c(al, stop_msg), str_type_len_msg)); + ASR::ttype_t *str_type_len_1 = ASRUtils::TYPE(ASR::make_Character_t( + al, loc, 1, 1, nullptr)); + ASR::expr_t* NEWLINE = ASRUtils::EXPR(ASR::make_StringConstant_t(al, loc, + s2c(al, "\n"), str_type_len_1)); + compute_fmt_specifier_and_arg(fmt, args, STOP_MSG, loc); + if (stop_code) { + ASR::expr_t* SPACE = ASRUtils::EXPR(ASR::make_StringConstant_t(al, loc, + s2c(al, " "), str_type_len_1)); + compute_fmt_specifier_and_arg(fmt, args, SPACE, loc); + compute_fmt_specifier_and_arg(fmt, args, stop_code, loc); + } + compute_fmt_specifier_and_arg(fmt, args, NEWLINE, loc); + + for (auto ch:fmt) { + fmt_str += ch; + } + + llvm::Value *fmt_ptr = builder->CreateGlobalStringPtr(fmt_str); + args[0] = fmt_ptr; + print_error(context, *module, *builder, args); + + if (stop_code && is_a(*ASRUtils::expr_type(stop_code))) { + this->visit_expr(*stop_code); exit_code = tmp; - if (compiler_options.emit_debug_info) { + } + exit(context, *module, *builder, exit_code); + } + + void visit_Stop(const ASR::Stop_t &x) { + if (compiler_options.emit_debug_info) { + debug_emit_loc(x); + if (x.m_code && is_a(*ASRUtils::expr_type(x.m_code))) { llvm::Value *fmt_ptr = builder->CreateGlobalStringPtr(infile); llvm::Value *fmt_ptr1 = llvm::ConstantInt::get(context, llvm::APInt( 1, compiler_options.use_colors)); - llvm::Value *test = builder->CreateICmpNE(exit_code, builder->getInt32(0)); + this->visit_expr(*x.m_code); + llvm::Value *test = builder->CreateICmpNE(tmp, builder->getInt32(0)); llvm_utils->create_if_else(test, [=]() { call_print_stacktrace_addresses(context, *module, *builder, {fmt_ptr, fmt_ptr1}); }, [](){}); } - } else { - int exit_code_int = 0; - exit_code = llvm::ConstantInt::get(context, - llvm::APInt(32, exit_code_int)); } - llvm::Value *fmt_ptr = builder->CreateGlobalStringPtr("STOP\n"); - print_error(context, *module, *builder, {fmt_ptr}); - exit(context, *module, *builder, exit_code); + + int exit_code_int = 0; + llvm::Value *exit_code = llvm::ConstantInt::get(context, + llvm::APInt(32, exit_code_int)); + construct_stop(exit_code, "STOP", x.m_code, x.base.base.loc); } void visit_ErrorStop(const ASR::ErrorStop_t &x) { @@ -7747,12 +8073,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor call_print_stacktrace_addresses(context, *module, *builder, {fmt_ptr, fmt_ptr1}); } - llvm::Value *fmt_ptr = builder->CreateGlobalStringPtr("ERROR STOP\n"); - print_error(context, *module, *builder, {fmt_ptr}); + int exit_code_int = 1; llvm::Value *exit_code = llvm::ConstantInt::get(context, llvm::APInt(32, exit_code_int)); - exit(context, *module, *builder, exit_code); + construct_stop(exit_code, "ERROR STOP", x.m_code, x.base.base.loc); } template @@ -7819,7 +8144,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor if( !ASRUtils::is_array(arg->m_type) ) { if (x_abi == ASR::abiType::Source && ASR::is_a(*arg->m_type)) { - if (arg->m_intent == intent_local) { + if ( orig_arg_intent != ASRUtils::intent_out && + arg->m_intent == intent_local ) { // Local variable of type // CPtr is a void**, so we // have to load it @@ -7866,9 +8192,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } } else if (is_a(*arg_type)) { - if (arg->m_intent == intent_local) { - // Local variable of type - // CPtr is a void**, so we + if ( arg->m_intent == intent_local || + arg->m_intent == ASRUtils::intent_out) { + // Local variable or Dummy out argument + // of type CPtr is a void**, so we // have to load it tmp = CreateLoad(tmp); } @@ -7897,6 +8224,20 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor builder->CreateStore(tmp, target); tmp = target; } + } else { + if( orig_arg && + !LLVM::is_llvm_pointer(*orig_arg->m_type) && + LLVM::is_llvm_pointer(*arg->m_type) && + ASRUtils::check_equal_type( + ASRUtils::type_get_past_allocatable( + ASRUtils::type_get_past_pointer(orig_arg->m_type)), + ASRUtils::type_get_past_allocatable( + ASRUtils::type_get_past_pointer(arg->m_type))) && + !ASRUtils::is_character(*arg->m_type) ) { + // TODO: Remove call to ASRUtils::check_equal_type + // pass(rhs) is not respected in integration_tests/class_08.f90 + tmp = LLVM::CreateLoad(*builder, tmp); + } } } else { if( orig_arg && @@ -7957,6 +8298,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } } else if (ASR::is_a(*x.m_args[i].m_value)) { this->visit_expr_wrapper(x.m_args[i].m_value); + } else if( ASR::is_a( + *ASRUtils::type_get_past_pointer( + ASRUtils::type_get_past_allocatable( + ASRUtils::expr_type(x.m_args[i].m_value)))) ) { + this->visit_expr_wrapper(x.m_args[i].m_value, true); } else { ASR::ttype_t* arg_type = expr_type(x.m_args[i].m_value); int64_t ptr_loads_copy = ptr_loads; @@ -8056,6 +8402,14 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor target_type = llvm_utils->get_type_from_ttype_t_util(arg_type_, module.get()); break ; } + case (ASR::ttypeType::FunctionType): { + target_type = llvm_utils->get_type_from_ttype_t_util(arg_type_, module.get()); + break; + } + case (ASR::ttypeType::Const): { + target_type = llvm_utils->get_type_from_ttype_t_util(ASRUtils::get_contained_type(arg_type), module.get()); + break; + } default : throw CodeGenError("Type " + ASRUtils::type_to_str(arg_type) + " not implemented yet."); } @@ -8287,21 +8641,41 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor return ; } } + + std::vector args; + if( x.m_dt && ASR::is_a(*x.m_dt) && + ASR::is_a(*ASRUtils::symbol_get_past_external(x.m_name)) && + ASR::is_a(*ASRUtils::symbol_type(x.m_name)) ) { + uint64_t ptr_loads_copy = ptr_loads; + ptr_loads = 1; + this->visit_expr(*x.m_dt); + ptr_loads = ptr_loads_copy; + llvm::Value* callee = LLVM::CreateLoad(*builder, tmp); + + args = convert_call_args(x, false); + llvm::FunctionType* fntype = llvm_utils->get_function_type( + ASR::down_cast(ASRUtils::expr_type(x.m_dt)), + module.get()); + tmp = builder->CreateCall(fntype, callee, args); + return ; + } + const ASR::symbol_t *proc_sym = symbol_get_past_external(x.m_name); std::string proc_sym_name = ""; bool is_deferred = false; + bool is_nopass = false; if( ASR::is_a(*proc_sym) ) { ASR::ClassProcedure_t* class_proc = ASR::down_cast(proc_sym); is_deferred = class_proc->m_is_deferred; proc_sym_name = class_proc->m_name; + is_nopass = class_proc->m_is_nopass; } if( is_deferred ) { visit_RuntimePolymorphicSubroutineCall(x, proc_sym_name); return ; } ASR::Function_t *s; - std::vector args; char* self_argument = nullptr; llvm::Value* pass_arg = nullptr; if (ASR::is_a(*proc_sym)) { @@ -8311,6 +8685,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor ASR::ClassProcedure_t>(proc_sym); s = ASR::down_cast(clss_proc->m_proc); self_argument = clss_proc->m_self_argument; + proc_sym = clss_proc->m_proc; } else if (ASR::is_a(*proc_sym)) { ASR::symbol_t *type_decl = ASR::down_cast(proc_sym)->m_type_declaration; LCOMPILERS_ASSERT(type_decl); @@ -8322,7 +8697,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor s = ASR::down_cast(symbol_get_past_external(x.m_name)); } bool is_method = false; - if (x.m_dt) { + if (x.m_dt && (!is_nopass)) { is_method = true; if (ASR::is_a(*x.m_dt)) { ASR::Variable_t *caller = EXPR2VAR(x.m_dt); @@ -8399,11 +8774,11 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor if (s_func_type->m_abi == ASR::abiType::LFortranModule) { throw CodeGenError("Subroutine LCompilers interfaces not implemented yet"); } else if (s_func_type->m_abi == ASR::abiType::Interactive) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else if (s_func_type->m_abi == ASR::abiType::Source) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else if (s_func_type->m_abi == ASR::abiType::BindC) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else if (s_func_type->m_abi == ASR::abiType::Intrinsic) { if (sub_name == "get_command_argument") { llvm::Function *fn = module->getFunction("_lpython_get_argv"); @@ -8452,7 +8827,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor tmp = builder->CreateCall(fn, {CreateLoad(args[0])}); return; } - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else { throw CodeGenError("ABI type not implemented yet in SubroutineCall."); } @@ -8763,14 +9138,34 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor return ; } + std::vector args; + if( x.m_dt && ASR::is_a(*x.m_dt) && + ASR::is_a(*ASRUtils::symbol_get_past_external(x.m_name)) && + ASR::is_a(*ASRUtils::symbol_type(x.m_name)) ) { + uint64_t ptr_loads_copy = ptr_loads; + ptr_loads = 1; + this->visit_expr(*x.m_dt); + ptr_loads = ptr_loads_copy; + llvm::Value* callee = LLVM::CreateLoad(*builder, tmp); + + args = convert_call_args(x, false); + llvm::FunctionType* fntype = llvm_utils->get_function_type( + ASR::down_cast(ASRUtils::expr_type(x.m_dt)), + module.get()); + tmp = builder->CreateCall(fntype, callee, args); + return ; + } + const ASR::symbol_t *proc_sym = symbol_get_past_external(x.m_name); std::string proc_sym_name = ""; bool is_deferred = false; + bool is_nopass = false; if( ASR::is_a(*proc_sym) ) { ASR::ClassProcedure_t* class_proc = ASR::down_cast(proc_sym); is_deferred = class_proc->m_is_deferred; proc_sym_name = class_proc->m_name; + is_nopass = class_proc->m_is_nopass; } if( is_deferred ) { visit_RuntimePolymorphicFunctionCall(x, proc_sym_name); @@ -8778,7 +9173,6 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } ASR::Function_t *s = nullptr; - std::vector args; std::string self_argument = ""; if (ASR::is_a(*proc_sym)) { s = ASR::down_cast(proc_sym); @@ -8788,6 +9182,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor s = ASR::down_cast(clss_proc->m_proc); if (clss_proc->m_self_argument) self_argument = std::string(clss_proc->m_self_argument); + proc_sym = clss_proc->m_proc; } else if (ASR::is_a(*proc_sym)) { ASR::symbol_t *type_decl = ASR::down_cast(proc_sym)->m_type_declaration; LCOMPILERS_ASSERT(type_decl); @@ -8800,7 +9195,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor } bool is_method = false; llvm::Value* pass_arg = nullptr; - if (x.m_dt) { + if (x.m_dt && (!is_nopass)) { is_method = true; if (ASR::is_a(*x.m_dt)) { ASR::Variable_t *caller = EXPR2VAR(x.m_dt); @@ -8900,28 +9295,23 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor handle_bitwise_or(x); return ; } - if( startswith(symbol_name, "allocated") ){ - LCOMPILERS_ASSERT(x.n_args == 1); - handle_allocated(x.m_args[0].m_value); - return ; - } } bool intrinsic_function = ASRUtils::is_intrinsic_function2(s); uint32_t h; ASR::FunctionType_t* s_func_type = ASR::down_cast(s->m_function_signature); if (s_func_type->m_abi == ASR::abiType::Source && !intrinsic_function) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else if (s_func_type->m_abi == ASR::abiType::LFortranModule) { throw CodeGenError("Function LCompilers interfaces not implemented yet"); } else if (s_func_type->m_abi == ASR::abiType::Interactive) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else if (s_func_type->m_abi == ASR::abiType::BindC) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else if (s_func_type->m_abi == ASR::abiType::Intrinsic || intrinsic_function) { std::string func_name = s->m_name; if( fname2arg_type.find(func_name) != fname2arg_type.end() ) { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } else { if (func_name == "len") { args = convert_call_args(x, is_method); @@ -8953,7 +9343,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor if( ASRUtils::get_FunctionType(s)->m_deftype == ASR::deftypeType::Interface ) { throw CodeGenError("Intrinsic '" + func_name + "' not implemented yet and compile time value is not available."); } else { - h = get_hash((ASR::asr_t*)s); + h = get_hash((ASR::asr_t*)proc_sym); } } } else { @@ -9073,6 +9463,13 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor ASR::ttype_t* x_mv_type = ASRUtils::expr_type(m_v); ASR::array_physical_typeType physical_type = ASRUtils::extract_physical_type(x_mv_type); + if (physical_type == ASR::array_physical_typeType::CharacterArraySinglePointer) { + if (ASRUtils::is_fixed_size_array(x_mv_type)) { + physical_type = ASR::array_physical_typeType::FixedSizeArray; + } else { + physical_type = ASR::array_physical_typeType::DescriptorArray; + } + } switch( physical_type ) { case ASR::array_physical_typeType::DescriptorArray: { tmp = arr_descr->get_array_size(llvm_arg, llvm_dim, output_kind, dim_kind); @@ -9216,6 +9613,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor { if( x.m_bound == ASR::arrayboundType::LBound ) { this->visit_expr_wrapper(m_dims[i].m_start, true); + tmp = builder->CreateSExtOrTrunc(tmp, target_type); builder->CreateStore(tmp, target); } else if( x.m_bound == ASR::arrayboundType::UBound ) { llvm::Value *lbound = nullptr, *length = nullptr; @@ -9237,6 +9635,82 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor tmp = LLVM::CreateLoad(*builder, target); break; } + case ASR::array_physical_typeType::SIMDArray: { + if( x.m_bound == ASR::arrayboundType::LBound ) { + tmp = llvm::ConstantInt::get(context, llvm::APInt(32, 1)); + } else if( x.m_bound == ASR::arrayboundType::UBound ) { + int64_t size = ASRUtils::get_fixed_size_of_array(ASRUtils::expr_type(x.m_v)); + tmp = llvm::ConstantInt::get(context, llvm::APInt(32, size)); + } + break; + } + case ASR::array_physical_typeType::CharacterArraySinglePointer: { + ASR::dimension_t* m_dims = nullptr; + int n_dims = ASRUtils::extract_dimensions_from_ttype(x_mv_type, m_dims); + if (ASRUtils::is_dimension_empty(m_dims, n_dims)) { + // treat it as DescriptorArray + llvm::Value* dim_des_val = arr_descr->get_pointer_to_dimension_descriptor_array(llvm_arg1); + llvm::Value* const_1 = llvm::ConstantInt::get(context, llvm::APInt(32, 1)); + dim_val = builder->CreateSub(dim_val, const_1); + llvm::Value* dim_struct = arr_descr->get_pointer_to_dimension_descriptor(dim_des_val, dim_val); + llvm::Value* res = nullptr; + if( x.m_bound == ASR::arrayboundType::LBound ) { + res = arr_descr->get_lower_bound(dim_struct); + } else if( x.m_bound == ASR::arrayboundType::UBound ) { + res = arr_descr->get_upper_bound(dim_struct); + } + tmp = res; + break; + } else if (ASRUtils::is_fixed_size_array(x_mv_type)) { + llvm::BasicBlock &entry_block = builder->GetInsertBlock()->getParent()->getEntryBlock(); + llvm::IRBuilder<> builder0(context); + builder0.SetInsertPoint(&entry_block, entry_block.getFirstInsertionPt()); + llvm::Type* target_type = llvm_utils->get_type_from_ttype_t_util( + ASRUtils::type_get_past_allocatable( + ASRUtils::type_get_past_pointer(x.m_type)), module.get()); + llvm::AllocaInst *target = builder0.CreateAlloca( + target_type, nullptr, "array_bound"); + llvm::BasicBlock *mergeBB = llvm::BasicBlock::Create(context, "ifcont"); + ASR::dimension_t* m_dims = nullptr; + int n_dims = ASRUtils::extract_dimensions_from_ttype(x_mv_type, m_dims); + for( int i = 0; i < n_dims; i++ ) { + llvm::Function *fn = builder->GetInsertBlock()->getParent(); + + llvm::BasicBlock *thenBB = llvm::BasicBlock::Create(context, "then", fn); + llvm::BasicBlock *elseBB = llvm::BasicBlock::Create(context, "else"); + + llvm::Value* cond = builder->CreateICmpEQ(dim_val, + llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), llvm::APInt(32, i + 1))); + builder->CreateCondBr(cond, thenBB, elseBB); + builder->SetInsertPoint(thenBB); + { + if( x.m_bound == ASR::arrayboundType::LBound ) { + this->visit_expr_wrapper(m_dims[i].m_start, true); + builder->CreateStore(tmp, target); + } else if( x.m_bound == ASR::arrayboundType::UBound ) { + llvm::Value *lbound = nullptr, *length = nullptr; + this->visit_expr_wrapper(m_dims[i].m_start, true); + lbound = tmp; + this->visit_expr_wrapper(m_dims[i].m_length, true); + length = tmp; + builder->CreateStore( + builder->CreateSub(builder->CreateAdd(length, lbound), + llvm::ConstantInt::get(context, llvm::APInt(32, 1))), + target); + } + } + builder->CreateBr(mergeBB); + + start_new_block(elseBB); + } + start_new_block(mergeBB); + tmp = LLVM::CreateLoad(*builder, target); + break; + } else { + LCOMPILERS_ASSERT(false); + break; + } + } default: { LCOMPILERS_ASSERT(false); } @@ -9249,23 +9723,37 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor // if (fmt_value) ... if (x.m_kind == ASR::string_format_kindType::FormatFortran) { std::vector args; - int size = x.n_args; - llvm::Value *count = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), size); - args.push_back(count); visit_expr(*x.m_fmt); args.push_back(tmp); for (size_t i=0; ifmt; + std::vector fmt; // Use the function to compute the args, but ignore the format compute_fmt_specifier_and_arg(fmt, args, x.m_args[i], x.base.base.loc); } + llvm::Value *args_cnt = llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), + args.size() - 1); + args.insert(args.begin(), args_cnt); tmp = string_format_fortran(context, *module, *builder, args); } else { throw CodeGenError("Only FormatFortran string formatting implemented so far."); } } + void visit_ArrayBroadcast(const ASR::ArrayBroadcast_t &x) { + this->visit_expr_wrapper(x.m_array, true); + llvm::Value *value = tmp; + llvm::Type* ele_type = llvm_utils->get_type_from_ttype_t_util( + ASRUtils::type_get_past_array(x.m_type), module.get()); + size_t n_eles = ASRUtils::get_fixed_size_of_array(x.m_type); + llvm::Type* vec_type = FIXED_VECTOR_TYPE::get(ele_type, n_eles); + llvm::AllocaInst *vec = builder->CreateAlloca(vec_type, nullptr); + for (size_t i=0; i < n_eles; i++) { + builder->CreateStore(value, llvm_utils->create_gep(vec, i)); + } + tmp = CreateLoad(vec); + } + }; @@ -9281,15 +9769,14 @@ Result> asr_to_llvm(ASR::TranslationUnit_t &asr, context.setOpaquePointers(false); #endif ASRToLLVMVisitor v(al, context, infile, co, diagnostics); - LCompilers::PassOptions pass_options; std::vector skip_optimization_func_instantiation; skip_optimization_func_instantiation.push_back(static_cast( - ASRUtils::IntrinsicScalarFunctions::FlipSign)); + ASRUtils::IntrinsicElementalFunctions::FlipSign)); skip_optimization_func_instantiation.push_back(static_cast( - ASRUtils::IntrinsicScalarFunctions::FMA)); + ASRUtils::IntrinsicElementalFunctions::FMA)); skip_optimization_func_instantiation.push_back(static_cast( - ASRUtils::IntrinsicScalarFunctions::SignFromValue)); + ASRUtils::IntrinsicElementalFunctions::SignFromValue)); co.po.run_fun = run_fn; co.po.always_run = false; diff --git a/src/libasr/codegen/asr_to_llvm.h b/src/libasr/codegen/asr_to_llvm.h index a099f54..a1e911e 100644 --- a/src/libasr/codegen/asr_to_llvm.h +++ b/src/libasr/codegen/asr_to_llvm.h @@ -2,7 +2,7 @@ #define LFORTRAN_ASR_TO_LLVM_H #include -#include +#include #include namespace LCompilers { diff --git a/src/libasr/codegen/asr_to_python.cpp b/src/libasr/codegen/asr_to_python.cpp new file mode 100644 index 0000000..204880b --- /dev/null +++ b/src/libasr/codegen/asr_to_python.cpp @@ -0,0 +1,637 @@ +#include +#include +#include +#include + +using LCompilers::ASR::is_a; +using LCompilers::ASR::down_cast; + +namespace LCompilers { + +enum Precedence { + Or = 4, + And = 5, + Not = 6, + CmpOp = 7, + Add = 12, + Sub = 12, + Mul = 13, + Div = 13, + BitNot = 14, + UnaryMinus = 14, + Exp = 15, + Pow = 15, + Constant = 18, +}; + +class ASRToLpythonVisitor : public ASR::BaseVisitor +{ +public: + Allocator& al; + diag::Diagnostics& diag; + std::string s; + bool use_colors; + int indent_level; + std::string indent; + int indent_spaces; + // Following same order as Python 3.x + // https://docs.python.org/3/reference/expressions.html#expression-lists + int last_expr_precedence; + +public: + ASRToLpythonVisitor(Allocator& al, diag::Diagnostics& diag, CompilerOptions& /*co*/, bool _use_colors, int _indent) + : al{ al }, diag{ diag }, use_colors{_use_colors}, indent_level{0}, + indent_spaces{_indent} + { } + + void inc_indent() { + indent_level++; + indent = std::string(indent_level*indent_spaces, ' '); + } + + void dec_indent() { + indent_level--; + indent = std::string(indent_level*indent_spaces, ' '); + } + + void visit_expr_with_precedence(const ASR::expr_t &x, int current_precedence) { + visit_expr(x); + if (last_expr_precedence == 18 || + last_expr_precedence < current_precedence) { + s = "(" + s + ")"; + } + } + + std::string binop2str(const ASR::binopType type) + { + switch (type) { + case (ASR::binopType::Add) : { + last_expr_precedence = Precedence::Add; + return " + "; + } case (ASR::binopType::Sub) : { + last_expr_precedence = Precedence::Sub; + return " - "; + } case (ASR::binopType::Mul) : { + last_expr_precedence = Precedence::Mul; + return " * "; + } case (ASR::binopType::Div) : { + last_expr_precedence = Precedence::Div; + return " / "; + } case (ASR::binopType::Pow) : { + last_expr_precedence = Precedence::Pow; + return " ** "; + } default : { + throw LCompilersException("Cannot represent the binary operator as a string"); + } + } + } + + std::string cmpop2str(const ASR::cmpopType type) + { + last_expr_precedence = Precedence::CmpOp; + switch (type) { + case (ASR::cmpopType::Eq) : return " == "; + case (ASR::cmpopType::NotEq) : return " != "; + case (ASR::cmpopType::Lt) : return " < "; + case (ASR::cmpopType::LtE) : return " <= "; + case (ASR::cmpopType::Gt) : return " > "; + case (ASR::cmpopType::GtE) : return " >= "; + default : throw LCompilersException("Cannot represent the boolean operator as a string"); + } + } + + std::string logicalbinop2str(const ASR::logicalbinopType type) + { + switch (type) { + case (ASR::logicalbinopType::And) : { + last_expr_precedence = Precedence::And; + return " and "; + } case (ASR::logicalbinopType::Or) : { + last_expr_precedence = Precedence::Or; + return " or "; + } default : { + throw LCompilersException("Cannot represent the boolean operator as a string"); + } + } + } + + template + void visit_body(const T &x, std::string &r, bool apply_indent=true) { + if (apply_indent) { + inc_indent(); + } + for (size_t i = 0; i < x.n_body; i++) { + visit_stmt(*x.m_body[i]); + r += s; + } + if (apply_indent) { + dec_indent(); + } + } + + std::string get_type(const ASR::ttype_t *t) { + std::string r = ""; + switch (t->type) { + case ASR::ttypeType::Integer : { + r += "i"; + r += std::to_string(ASRUtils::extract_kind_from_ttype_t(t)*8); + break; + } case ASR::ttypeType::Real : { + r += "f"; + r += std::to_string(ASRUtils::extract_kind_from_ttype_t(t)*8); + break; + } case ASR::ttypeType::Complex : { + r += "c"; + r += std::to_string(ASRUtils::extract_kind_from_ttype_t(t)*8); + break; + } case ASR::ttypeType::Character : { + r = "str"; + break; + } case ASR::ttypeType::Logical : { + r = "bool"; + break; + } default : { + throw LCompilersException("The type `" + + ASRUtils::type_to_str_python(t) + "` is not handled yet"); + } + } + return r; + } + + void visit_TranslationUnit(const ASR::TranslationUnit_t &x) { + std::string r = ""; + + for (auto &item : x.m_symtab->get_scope()) { + if (is_a(*item.second)) { + visit_symbol(*item.second); + r += s; + } + } + + for (auto &item : x.m_symtab->get_scope()) { + if (is_a(*item.second)) { + visit_symbol(*item.second); + r += s; + } + } + + // Main program + for (auto &item : x.m_symtab->get_scope()) { + if (is_a(*item.second)) { + visit_symbol(*item.second); + r += s; + } + } + s = r; + } + + void visit_Module(const ASR::Module_t &x) { + std::string r; + + for (auto &item : x.m_symtab->get_scope()) { + if (is_a(*item.second)) { + visit_symbol(*item.second); + r += s; + } + } + s = r; + } + + void visit_Function(const ASR::Function_t &x) { + // Generate code for the lpython function + std::string r; + r = "def"; + r += " "; + r.append(x.m_name); + r += "("; + for (size_t i = 0; i < x.n_args; i++) { + visit_expr(*x.m_args[i]); + r += s; + // TODO: Specify the datatype of the argument here + if (i < x.n_args - 1) { + r += ", "; + } + } + r += "):"; + r += "\n"; + + inc_indent(); + for (auto &item : x.m_symtab->get_scope()) { + if (is_a(*item.second)) { + visit_symbol(*item.second); + r += s; + } + } + dec_indent(); + + visit_body(x, r, true); + + s = r; + } + + void visit_Program(const ASR::Program_t &x) { + std::string r; + + for (auto &item : x.m_symtab->get_scope()) { + if (is_a(*item.second)) { + visit_symbol(*item.second); + r += s; + } + } + s = r; + } + + void visit_Variable(const ASR::Variable_t &x) { + std::string r = indent; + r += x.m_name; + r += ": "; + r += get_type(x.m_type); + r += "\n"; + s = r; + } + + void visit_Print(const ASR::Print_t &x) { + std::string r = indent; + r += "print("; + for (size_t i = 0; i < x.n_values; i++) { + visit_expr(*x.m_values[i]); + r += s; + if (i < x.n_values-1) + r += ", "; + } + r += ")"; + r += "\n"; + s = r; + } + + void visit_Assignment(const ASR::Assignment_t &x) { + std::string r = indent; + visit_expr(*x.m_target); + r += s; + r += " = "; + visit_expr(*x.m_value); + r += s; + r += "\n"; + s = r; + } + + void visit_Return(const ASR::Return_t /*&x*/) { + // TODO: Handle cases for returning an expression/value + s = indent + "return" + "\n"; + } + + void visit_SubroutineCall(const ASR::SubroutineCall_t &x) { + std::string r = indent; + r += ASRUtils::symbol_name(x.m_name); + r += "("; + for (size_t i = 0; i < x.n_args; i++) { + visit_expr(*x.m_args[i].m_value); + r += s; + if (i < x.n_args - 1) + r += ", "; + } + r += ")\n"; + s = r; + } + + void visit_FunctionCall(const ASR::FunctionCall_t &x) { + std::string r = ""; + if (x.m_original_name) { + r += ASRUtils::symbol_name(x.m_original_name); + } else { + r += ASRUtils::symbol_name(x.m_name); + } + + r += "("; + for (size_t i = 0; i < x.n_args; i++) { + visit_expr(*x.m_args[i].m_value); + r += s; + if (i < x.n_args - 1) + r += ", "; + } + r += ")"; + s = r; + } + + void visit_Cast(const ASR::Cast_t &x) { + // TODO + visit_expr(*x.m_arg); + } + + void visit_Var(const ASR::Var_t &x) { + s = ASRUtils::symbol_name(x.m_v); + } + + void visit_If(const ASR::If_t &x) { + std::string r = indent; + r += "if "; + visit_expr(*x.m_test); + r += s; + r += ":\n"; + inc_indent(); + for (size_t i = 0; i < x.n_body; i++) { + visit_stmt(*x.m_body[i]); + r += s; + } + dec_indent(); + if (x.n_orelse == 0) { + r += "\n"; + } else { + for (size_t i = 0; i < x.n_orelse; i++) { + r += indent + "else:\n"; + inc_indent(); + visit_stmt(*x.m_orelse[i]); + r += s; + dec_indent(); + } + } + s = r; + } + + void visit_WhileLoop(const ASR::WhileLoop_t &x) { + std::string r = indent; + r += "while "; + visit_expr(*x.m_test); + r += s; + r += ":\n"; + visit_body(x, r); + s = r; + } + + void visit_NamedExpr(const ASR::NamedExpr_t &x) { + this->visit_expr(*x.m_target); + std::string t = std::move(s); + this->visit_expr(*x.m_value); + std::string v = std::move(s); + s = "(" + t + " := " + v + ")"; + } + + void visit_ExplicitDeallocate(const ASR::ExplicitDeallocate_t &x) { + std::string r = indent; + r += "del "; + for (size_t i = 0; i < x.n_vars; i++) { + if (i > 0) { + r += ", "; + } + visit_expr(*x.m_vars[i]); + r += s; + } + s = r; + } + + void visit_IntrinsicElementalFunction(const ASR::IntrinsicElementalFunction_t &x) { + std::string out; + switch (x.m_intrinsic_id) { + SET_INTRINSIC_NAME(Abs, "abs"); + default : { + throw LCompilersException("IntrinsicScalarFunction: `" + + ASRUtils::get_intrinsic_name(x.m_intrinsic_id) + + "` is not implemented"); + } + } + LCOMPILERS_ASSERT(x.n_args == 1); + visit_expr(*x.m_args[0]); + out += "(" + s + ")"; + s = out; + } + + void visit_StringCompare(const ASR::StringCompare_t &x) { + std::string r; + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += cmpop2str(x.m_op); + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_StringConstant(const ASR::StringConstant_t &x) { + s = "\""; + s.append(x.m_s); + s += "\""; + last_expr_precedence = Precedence::Constant; + } + + void visit_StringChr(const ASR::StringChr_t &x) { + visit_expr(*x.m_arg); + s = "chr(" + s + ")"; + } + + void visit_IntegerBinOp(const ASR::IntegerBinOp_t &x) { + std::string r; + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += binop2str(x.m_op); + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_IntegerCompare(const ASR::IntegerCompare_t &x) { + std::string r; + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += cmpop2str(x.m_op); + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_IntegerConstant(const ASR::IntegerConstant_t &x) { + s = std::to_string(x.m_n); + last_expr_precedence = Precedence::Constant; + } + + void visit_IntegerUnaryMinus(const ASR::IntegerUnaryMinus_t &x) { + visit_expr_with_precedence(*x.m_arg, 14); + s = "-" + s; + last_expr_precedence = Precedence::UnaryMinus; + } + + void visit_IntegerBitNot(const ASR::IntegerBitNot_t &x) { + visit_expr_with_precedence(*x.m_arg, 14); + s = "~" + s; + last_expr_precedence = Precedence::BitNot; + } + + void visit_RealConstant(const ASR::RealConstant_t &x) { + s = std::to_string(x.m_r); + last_expr_precedence = Precedence::Constant; + } + + void visit_RealCompare(const ASR::RealCompare_t &x) { + std::string r; + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += cmpop2str(x.m_op); + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_RealUnaryMinus(const ASR::RealUnaryMinus_t &x) { + visit_expr_with_precedence(*x.m_arg, 14); + s = "-" + s; + last_expr_precedence = Precedence::UnaryMinus; + } + + void visit_RealBinOp(const ASR::RealBinOp_t &x) { + std::string r; + std::string m_op = binop2str(x.m_op); + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += m_op; + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_LogicalConstant(const ASR::LogicalConstant_t &x) { + std::string r; + if (x.m_value) { + r += "True"; + } else { + r += "False"; + } + s = r; + last_expr_precedence = Precedence::Constant; + } + + void visit_LogicalBinOp(const ASR::LogicalBinOp_t &x) { + std::string r; + std::string m_op = logicalbinop2str(x.m_op); + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += m_op; + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_LogicalCompare(const ASR::LogicalCompare_t &x) { + std::string r; + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += cmpop2str(x.m_op); + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_LogicalNot(const ASR::LogicalNot_t &x) { + visit_expr_with_precedence(*x.m_arg, 6); + s = "not " + s; + last_expr_precedence = Precedence::Not; + } + + void visit_StringConcat(const ASR::StringConcat_t &x) { + this->visit_expr(*x.m_left); + std::string left = std::move(s); + this->visit_expr(*x.m_right); + std::string right = std::move(s); + s = left + " + " + right; + } + + void visit_StringRepeat(const ASR::StringRepeat_t &x) { + this->visit_expr(*x.m_left); + std::string left = std::move(s); + this->visit_expr(*x.m_right); + std::string right = std::move(s); + s = left + " * " + right; + } + + void visit_StringOrd(const ASR::StringOrd_t &x) { + std::string r; + r = "ord("; + visit_expr(*x.m_arg); + r += s; + r += ")"; + s = r; + } + + void visit_StringLen(const ASR::StringLen_t &x) { + visit_expr(*x.m_arg); + s += "len(" + s + ")"; + } + + void visit_IfExp(const ASR::IfExp_t &x) { + std::string r; + visit_expr(*x.m_body); + r += s; + r += " if "; + visit_expr(*x.m_test); + r += s; + r += " else "; + visit_expr(*x.m_orelse); + r += s; + s = r; + } + + void visit_ComplexConstant(const ASR::ComplexConstant_t &x) { + std::string re = std::to_string(x.m_re); + std::string im = std::to_string(x.m_im); + s = "complex(" + re + ", " + im + ")"; + } + + void visit_ComplexUnaryMinus(const ASR::ComplexUnaryMinus_t &x) { + visit_expr_with_precedence(*x.m_arg, 14); + s = "-" + s; + last_expr_precedence = Precedence::UnaryMinus; + } + + void visit_ComplexCompare(const ASR::ComplexCompare_t &x) { + std::string r; + int current_precedence = last_expr_precedence; + visit_expr_with_precedence(*x.m_left, current_precedence); + r += s; + r += cmpop2str(x.m_op); + visit_expr_with_precedence(*x.m_right, current_precedence); + r += s; + last_expr_precedence = current_precedence; + s = r; + } + + void visit_Assert(const ASR::Assert_t &x) { + std::string r = indent; + r += "assert "; + visit_expr(*x.m_test); + r += s; + if (x.m_msg) { + r += ", "; + visit_expr(*x.m_msg); + r += s; + } + r += "\n"; + s = r; + } + +}; + +Result asr_to_python(Allocator& al, ASR::TranslationUnit_t &asr, + diag::Diagnostics& diagnostics, CompilerOptions& co, + bool color, int indent) { + ASRToLpythonVisitor v(al, diagnostics, co, color, indent=4); + try { + v.visit_TranslationUnit(asr); + } catch (const CodeGenError &e) { + diagnostics.diagnostics.push_back(e.d); + return Error(); + } + return v.s; +} + +} // namespace LCompilers diff --git a/src/libasr/codegen/asr_to_python.h b/src/libasr/codegen/asr_to_python.h new file mode 100644 index 0000000..fa812a7 --- /dev/null +++ b/src/libasr/codegen/asr_to_python.h @@ -0,0 +1,16 @@ +#ifndef LPYTHON_ASR_TO_PYTHON_H +#define LPYTHON_ASR_TO_PYTHON_H + +#include +#include + +namespace LCompilers { + + // Convert ASR to Python source code + Result asr_to_python(Allocator &al, ASR::TranslationUnit_t &asr, + diag::Diagnostics &diagnostics, CompilerOptions &co, + bool color, int indent); + +} // namespace LCompilers + +#endif // LPYTHON_ASR_TO_PYTHON_H diff --git a/src/libasr/codegen/asr_to_wasm.cpp b/src/libasr/codegen/asr_to_wasm.cpp index d89eb11..8ca62ff 100644 --- a/src/libasr/codegen/asr_to_wasm.cpp +++ b/src/libasr/codegen/asr_to_wasm.cpp @@ -859,7 +859,6 @@ class ASRToWASMVisitor : public ASR::BaseVisitor { if (ASRUtils::is_pointer(v->m_type)) { ASR::ttype_t *t2 = ASR::down_cast(v->m_type)->m_type; - t2 = ASRUtils::type_get_past_const(t2); if (ASRUtils::is_integer(*t2)) { ASR::Integer_t *t = ASR::down_cast(t2); diag.codegen_warning_label( @@ -873,17 +872,6 @@ class ASRToWASMVisitor : public ASR::BaseVisitor { throw CodeGenError( "Integers of kind 4 and 8 only supported"); } - } else if (ASRUtils::is_character(*t2)) { - ASR::Character_t *t = ASR::down_cast(t2); - diag.codegen_warning_label( - "Pointers are not currently supported", {v->base.base.loc}, - "emitting integer for now"); - if (t->m_kind == 1) { - type_vec.push_back(i32); - } else { - throw CodeGenError( - "Characters of kind 1 only supported"); - } } else { diag.codegen_error_label("Type number '" + std::to_string(v->m_type->type) + @@ -2446,12 +2434,12 @@ class ASRToWASMVisitor : public ASR::BaseVisitor { if (m_func_name_idx_map.find(hash) != m_func_name_idx_map.end()) { m_wa.emit_call(m_func_name_idx_map[hash].index); } else { - if (strcmp(fn->m_name, "c_caimag") == 0) { + if (strcmp(fn->m_name, "_lfortran_caimag") == 0) { LCOMPILERS_ASSERT(x.n_args == 1); m_wa.emit_global_set(m_compiler_globals[tmp_reg_f32]); m_wa.emit_drop(); m_wa.emit_global_get(m_compiler_globals[tmp_reg_f32]); - } else if (strcmp(fn->m_name, "c_zaimag") == 0) { + } else if (strcmp(fn->m_name, "_lfortran_zaimag") == 0) { m_wa.emit_global_set(m_compiler_globals[tmp_reg_f64]); m_wa.emit_drop(); m_wa.emit_global_get(m_compiler_globals[tmp_reg_f64]); @@ -3208,6 +3196,10 @@ class ASRToWASMVisitor : public ASR::BaseVisitor { wasm_exit(); }); } + + void visit_TypeInquiry(const ASR::TypeInquiry_t &x) { + this->visit_expr(*x.m_value); + } }; Result> asr_to_wasm_bytes_stream(ASR::TranslationUnit_t &asr, diff --git a/src/libasr/codegen/c_utils.h b/src/libasr/codegen/c_utils.h index e6a65e0..b21d7b2 100644 --- a/src/libasr/codegen/c_utils.h +++ b/src/libasr/codegen/c_utils.h @@ -290,6 +290,11 @@ namespace CUtils { type_src = get_c_type_from_ttype_t(ptr_type->m_type) + "*"; break; } + case ASR::ttypeType::Const: { + ASR::Const_t* ptr_type = ASR::down_cast(t); + type_src = "const " + get_c_type_from_ttype_t(ptr_type->m_type); + break; + } case ASR::ttypeType::CPtr: { type_src = "void*"; break; @@ -555,6 +560,7 @@ class CCPPDSUtils { new_array_type = struct_name + "\n{\n " + array_data + ";\n struct dimension_descriptor dims[32];\n" + " int32_t n_dims;\n" + " int32_t offset;\n" " bool is_allocated;\n};\n"; if( make_ptr ) { type_name = struct_name + "*"; diff --git a/src/libasr/codegen/llvm_array_utils.cpp b/src/libasr/codegen/llvm_array_utils.cpp index f27ead8..bc14cb6 100644 --- a/src/libasr/codegen/llvm_array_utils.cpp +++ b/src/libasr/codegen/llvm_array_utils.cpp @@ -261,28 +261,22 @@ namespace LCompilers { llvm::Value* offset_val = llvm_utils->create_gep(arr, 1); builder->CreateStore(llvm::ConstantInt::get(context, llvm::APInt(32, 0)), offset_val); llvm::Value* dim_des_val = llvm_utils->create_gep(arr, 2); - llvm::Value* llvm_ndims = builder->CreateAlloca(llvm::Type::getInt32Ty(context), nullptr); - builder->CreateStore(llvm::ConstantInt::get(context, llvm::APInt(32, n_dims)), llvm_ndims); - llvm::Value* dim_des_first = builder->CreateAlloca(dim_des, - LLVM::CreateLoad(*builder, llvm_ndims)); - builder->CreateStore(llvm::ConstantInt::get(context, llvm::APInt(32, n_dims)), get_rank(arr, true)); + llvm::Value* arr_rank = llvm::ConstantInt::get(context, llvm::APInt(32, n_dims)); + llvm::Value* dim_des_first = builder->CreateAlloca(dim_des, arr_rank); builder->CreateStore(dim_des_first, dim_des_val); + builder->CreateStore(arr_rank, get_rank(arr, true)); dim_des_val = LLVM::CreateLoad(*builder, dim_des_val); - for( int r = 0; r < n_dims; r++ ) { - llvm::Value* dim_val = llvm_utils->create_ptr_gep(dim_des_val, r); - llvm::Value* l_val = llvm_utils->create_gep(dim_val, 1); - llvm::Value* dim_size_ptr = llvm_utils->create_gep(dim_val, 2); - builder->CreateStore(llvm_dims[r].first, l_val); - llvm::Value* dim_size = llvm_dims[r].second; - builder->CreateStore(dim_size, dim_size_ptr); - } llvm::Value* prod = llvm::ConstantInt::get(context, llvm::APInt(32, 1)); for( int r = n_dims - 1; r >= 0; r-- ) { llvm::Value* dim_val = llvm_utils->create_ptr_gep(dim_des_val, r); llvm::Value* s_val = llvm_utils->create_gep(dim_val, 0); + llvm::Value* l_val = llvm_utils->create_gep(dim_val, 1); + llvm::Value* dim_size_ptr = llvm_utils->create_gep(dim_val, 2); builder->CreateStore(prod, s_val); + builder->CreateStore(llvm_dims[r].first, l_val); llvm::Value* dim_size = llvm_dims[r].second; prod = builder->CreateMul(prod, dim_size); + builder->CreateStore(dim_size, dim_size_ptr); } if( !reserve_data_memory ) { return ; @@ -343,20 +337,17 @@ namespace LCompilers { builder->CreateStore(llvm::ConstantInt::get(context, llvm::APInt(32, 0)), offset_val); llvm::Value* dim_des_val = LLVM::CreateLoad(*builder, llvm_utils->create_gep(arr, 2)); - for( int r = 0; r < n_dims; r++ ) { - llvm::Value* dim_val = llvm_utils->create_ptr_gep(dim_des_val, r); - llvm::Value* l_val = llvm_utils->create_gep(dim_val, 1); - llvm::Value* dim_size_ptr = llvm_utils->create_gep(dim_val, 2); - builder->CreateStore(llvm_dims[r].first, l_val); - llvm::Value* dim_size = llvm_dims[r].second; - builder->CreateStore(dim_size, dim_size_ptr); - } llvm::Value* prod = llvm::ConstantInt::get(context, llvm::APInt(32, 1)); for( int r = n_dims - 1; r >= 0; r-- ) { llvm::Value* dim_val = llvm_utils->create_ptr_gep(dim_des_val, r); llvm::Value* s_val = llvm_utils->create_gep(dim_val, 0); + llvm::Value* l_val = llvm_utils->create_gep(dim_val, 1); + llvm::Value* dim_size_ptr = llvm_utils->create_gep(dim_val, 2); + llvm::Value* first = builder->CreateSExtOrTrunc(llvm_dims[r].first, llvm::Type::getInt32Ty(context)); + llvm::Value* dim_size = builder->CreateSExtOrTrunc(llvm_dims[r].second, llvm::Type::getInt32Ty(context)); builder->CreateStore(prod, s_val); - llvm::Value* dim_size = llvm_dims[r].second; + builder->CreateStore(first, l_val); + builder->CreateStore(dim_size, dim_size_ptr); prod = builder->CreateMul(prod, dim_size); } llvm::Value* ptr2firstptr = get_pointer_to_data(arr); @@ -451,18 +442,20 @@ namespace LCompilers { int j = 0; for( int i = 0; i < value_rank; i++ ) { if( ds[i] != nullptr ) { + llvm::Value* ubsi = builder->CreateSExtOrTrunc(ubs[i], llvm::Type::getInt32Ty(context)); + llvm::Value* lbsi = builder->CreateSExtOrTrunc(lbs[i], llvm::Type::getInt32Ty(context)); + llvm::Value* dsi = builder->CreateSExtOrTrunc(ds[i], llvm::Type::getInt32Ty(context)); llvm::Value* dim_length = builder->CreateAdd( - builder->CreateSDiv( - builder->CreateSub(ubs[i], lbs[i]), - ds[i]), - llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), - llvm::APInt(32, 1)) - ); + builder->CreateSDiv(builder->CreateSub(ubsi, lbsi), dsi), + llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), + llvm::APInt(32, 1)) + ); llvm::Value* value_dim_des = llvm_utils->create_ptr_gep(value_dim_des_array, i); llvm::Value* target_dim_des = llvm_utils->create_ptr_gep(target_dim_des_array, j); llvm::Value* value_stride = get_stride(value_dim_des, true); llvm::Value* target_stride = get_stride(target_dim_des, false); - builder->CreateStore(value_stride, target_stride); + builder->CreateStore(builder->CreateMul(value_stride, builder->CreateZExtOrTrunc( + ds[i], llvm::Type::getInt32Ty(context))), target_stride); // Diverges from LPython, 0 should be stored there. builder->CreateStore(llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), llvm::APInt(32, 0)), get_lower_bound(target_dim_des, false)); @@ -507,16 +500,17 @@ namespace LCompilers { llvm::Value* stride = llvm::ConstantInt::get(context, llvm::APInt(32, 1)); for( int i = value_rank - 1; i >= 0; i-- ) { if( ds[i] != nullptr ) { + llvm::Value* ubsi = builder->CreateSExtOrTrunc(ubs[i], llvm::Type::getInt32Ty(context)); + llvm::Value* lbsi = builder->CreateSExtOrTrunc(lbs[i], llvm::Type::getInt32Ty(context)); + llvm::Value* dsi = builder->CreateSExtOrTrunc(ds[i], llvm::Type::getInt32Ty(context)); llvm::Value* dim_length = builder->CreateAdd( - builder->CreateSDiv( - builder->CreateSub(ubs[i], lbs[i]), - ds[i]), - llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), - llvm::APInt(32, 1)) - ); + builder->CreateSDiv(builder->CreateSub(ubsi, lbsi), dsi), + llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), + llvm::APInt(32, 1)) + ); llvm::Value* target_dim_des = llvm_utils->create_ptr_gep(target_dim_des_array, j); - builder->CreateStore(stride, - get_stride(target_dim_des, false)); + builder->CreateStore(builder->CreateMul(stride, builder->CreateZExtOrTrunc( + ds[i], llvm::Type::getInt32Ty(context))), get_stride(target_dim_des, false)); builder->CreateStore(llvm::ConstantInt::get(llvm::Type::getInt32Ty(context), llvm::APInt(32, 0)), get_lower_bound(target_dim_des, false)); builder->CreateStore(dim_length, @@ -586,6 +580,8 @@ namespace LCompilers { llvm::Value* curr_llvm_idx = m_args[r]; llvm::Value* dim_des_ptr = llvm_utils->create_ptr_gep(dim_des_arr_ptr, r); llvm::Value* lval = LLVM::CreateLoad(*builder, llvm_utils->create_gep(dim_des_ptr, 1)); + // first cast curr_llvm_idx to 32 bit + curr_llvm_idx = builder->CreateSExtOrTrunc(curr_llvm_idx, llvm::Type::getInt32Ty(context)); curr_llvm_idx = builder->CreateSub(curr_llvm_idx, lval); if( check_for_bounds ) { // check_single_element(curr_llvm_idx, arr); TODO: To be implemented @@ -605,6 +601,8 @@ namespace LCompilers { for( int r = n_args - 1, r1 = 2*n_args - 2; r >= 0; r-- ) { llvm::Value* curr_llvm_idx = m_args[r]; llvm::Value* lval = llvm_diminfo[r1]; + // first cast curr_llvm_idx to 32 bit + curr_llvm_idx = builder->CreateSExtOrTrunc(curr_llvm_idx, llvm::Type::getInt32Ty(context)); curr_llvm_idx = builder->CreateSub(curr_llvm_idx, lval); if( check_for_bounds ) { // check_single_element(curr_llvm_idx, arr); TODO: To be implemented @@ -676,7 +674,7 @@ namespace LCompilers { if( dim ) { tmp = builder->CreateSub(dim, llvm::ConstantInt::get(context, llvm::APInt(dim_kind * 8, 1))); tmp = this->get_dimension_size(dim_des_val, tmp); - tmp = builder->CreateSExt(tmp, llvm_utils->getIntType(kind)); + tmp = builder->CreateSExtOrTrunc(tmp, llvm_utils->getIntType(kind)); return tmp; } llvm::BasicBlock &entry_block = builder->GetInsertBlock()->getParent()->getEntryBlock(); @@ -702,7 +700,7 @@ namespace LCompilers { llvm::Value* r_val = LLVM::CreateLoad(*builder, r); llvm::Value* ret_val = LLVM::CreateLoad(*builder, llvm_size); llvm::Value* dim_size = this->get_dimension_size(dim_des_val, r_val); - dim_size = builder->CreateSExt(dim_size, llvm_utils->getIntType(kind)); + dim_size = builder->CreateSExtOrTrunc(dim_size, llvm_utils->getIntType(kind)); ret_val = builder->CreateMul(ret_val, dim_size); builder->CreateStore(ret_val, llvm_size); r_val = builder->CreateAdd(r_val, llvm::ConstantInt::get(context, llvm::APInt(32, 1))); @@ -738,8 +736,8 @@ namespace LCompilers { num_elements); builder->CreateStore( - llvm::ConstantInt::get(context, llvm::APInt(32, 0)), - this->get_offset(reshaped, false)); + llvm::ConstantInt::get(context, llvm::APInt(32, 0)), + this->get_offset(reshaped, false)); if( this->is_array(asr_shape_type) ) { builder->CreateStore(LLVM::CreateLoad(*builder, llvm_utils->create_gep(array, 1)), diff --git a/src/libasr/codegen/llvm_utils.cpp b/src/libasr/codegen/llvm_utils.cpp index 88f77ec..61e19a6 100644 --- a/src/libasr/codegen/llvm_utils.cpp +++ b/src/libasr/codegen/llvm_utils.cpp @@ -627,6 +627,33 @@ namespace LCompilers { v_type->m_dims, v_type->n_dims))->getPointerTo(); break; } + case ASR::array_physical_typeType::CharacterArraySinglePointer: { + // type = character_type->getPointerTo(); + // is_array_type = true; + // llvm::Type* el_type = get_el_type(v_type->m_type, module); + // type = arr_api->get_array_type(asr_type, el_type, get_pointer); + // break; + if (ASRUtils::is_fixed_size_array(v_type->m_dims, v_type->n_dims)) { + // llvm_type = character_type; -- @character_01.c = internal global i8* null + // llvm_type = character_type->getPointerTo(); -- @character_01.c = internal global i8** null + // llvm_type = llvm::ArrayType::get(character_type, + // ASRUtils::get_fixed_size_of_array(v_type->m_dims, v_type->n_dims))->getPointerTo(); + // -- @character_01 = internal global [2 x i8*]* zeroinitializer + + type = llvm::ArrayType::get(character_type, + ASRUtils::get_fixed_size_of_array(v_type->m_dims, v_type->n_dims)); + break; + } else if (ASRUtils::is_dimension_empty(v_type->m_dims, v_type->n_dims)) { + // Treat it as a DescriptorArray + is_array_type = true; + llvm::Type* el_type = character_type; + type = arr_api->get_array_type(asr_type, el_type); + break; + } else { + LCOMPILERS_ASSERT(false); + break; + } + } default: { LCOMPILERS_ASSERT(false); } @@ -1104,6 +1131,208 @@ namespace LCompilers { return function_type; } + std::vector LLVMUtils::convert_args(ASR::FunctionType_t* x, llvm::Module* module) { + std::vector args; + for (size_t i=0; i < x->n_arg_types; i++) { + llvm::Type *type = nullptr, *type_original = nullptr; + int n_dims = 0, a_kind = 4; + bool is_array_type = false; + type_original = get_arg_type_from_ttype_t(x->m_arg_types[i], + nullptr, x->m_abi, x->m_abi, ASR::storage_typeType::Default, + false, n_dims, a_kind, is_array_type, ASR::intentType::Unspecified, + module, false); + if( is_array_type ) { + type = type_original->getPointerTo(); + } else { + type = type_original; + } + args.push_back(type); + } + return args; + } + + llvm::FunctionType* LLVMUtils::get_function_type(ASR::FunctionType_t* x, llvm::Module* module) { + llvm::Type *return_type; + if (x->m_return_var_type) { + ASR::ttype_t* return_var_type0 = x->m_return_var_type; + ASR::ttypeType return_var_type = return_var_type0->type; + switch (return_var_type) { + case (ASR::ttypeType::Integer) : { + int a_kind = ASR::down_cast(return_var_type0)->m_kind; + return_type = getIntType(a_kind); + break; + } + case (ASR::ttypeType::UnsignedInteger) : { + int a_kind = ASR::down_cast(return_var_type0)->m_kind; + return_type = getIntType(a_kind); + break; + } + case (ASR::ttypeType::Real) : { + int a_kind = ASR::down_cast(return_var_type0)->m_kind; + return_type = getFPType(a_kind); + break; + } + case (ASR::ttypeType::Complex) : { + int a_kind = ASR::down_cast(return_var_type0)->m_kind; + if (a_kind == 4) { + if (x->m_abi == ASR::abiType::BindC) { + if (compiler_options.platform == Platform::Windows) { + // i64 + return_type = llvm::Type::getInt64Ty(context); + } else if (compiler_options.platform == Platform::macOS_ARM) { + // {float, float} + return_type = getComplexType(a_kind); + } else { + // <2 x float> + return_type = FIXED_VECTOR_TYPE::get(llvm::Type::getFloatTy(context), 2); + } + } else { + return_type = getComplexType(a_kind); + } + } else { + LCOMPILERS_ASSERT(a_kind == 8) + if (x->m_abi == ASR::abiType::BindC) { + if (compiler_options.platform == Platform::Windows) { + // pass as subroutine + return_type = getComplexType(a_kind, true); + std::vector args = convert_args(x, module); + args.insert(args.begin(), return_type); + llvm::FunctionType *function_type = llvm::FunctionType::get( + llvm::Type::getVoidTy(context), args, false); + return function_type; + } else { + return_type = getComplexType(a_kind); + } + } else { + return_type = getComplexType(a_kind); + } + } + break; + } + case (ASR::ttypeType::Character) : + return_type = character_type; + break; + case (ASR::ttypeType::Logical) : + return_type = llvm::Type::getInt1Ty(context); + break; + case (ASR::ttypeType::CPtr) : + return_type = llvm::Type::getVoidTy(context)->getPointerTo(); + break; + case (ASR::ttypeType::Const) : { + return_type = get_type_from_ttype_t_util(ASRUtils::get_contained_type(return_var_type0), module); + break; + } + case (ASR::ttypeType::Pointer) : { + return_type = get_type_from_ttype_t_util(ASRUtils::get_contained_type(return_var_type0), module)->getPointerTo(); + break; + } + case (ASR::ttypeType::Allocatable) : { + // TODO: Do getPointerTo as well. + return_type = get_type_from_ttype_t_util(ASRUtils::get_contained_type(return_var_type0), module); + break; + } + case (ASR::ttypeType::Struct) : + throw CodeGenError("Struct return type not implemented yet"); + break; + case (ASR::ttypeType::Tuple) : { + ASR::Tuple_t* asr_tuple = ASR::down_cast(return_var_type0); + std::string type_code = ASRUtils::get_type_code(asr_tuple->m_type, + asr_tuple->n_type); + std::vector llvm_el_types; + for( size_t i = 0; i < asr_tuple->n_type; i++ ) { + bool is_local_array_type = false, is_local_malloc_array_type = false; + bool is_local_list = false; + ASR::dimension_t* local_m_dims = nullptr; + int local_n_dims = 0; + int local_a_kind = -1; + ASR::storage_typeType local_m_storage = ASR::storage_typeType::Default; + llvm_el_types.push_back(get_type_from_ttype_t( + asr_tuple->m_type[i], nullptr, local_m_storage, + is_local_array_type, is_local_malloc_array_type, + is_local_list, local_m_dims, local_n_dims, local_a_kind, module)); + } + return_type = tuple_api->get_tuple_type(type_code, llvm_el_types); + break; + } + case (ASR::ttypeType::List) : { + bool is_array_type = false, is_malloc_array_type = false; + bool is_list = true; + ASR::dimension_t *m_dims = nullptr; + ASR::storage_typeType m_storage = ASR::storage_typeType::Default; + int n_dims = 0, a_kind = -1; + ASR::List_t* asr_list = ASR::down_cast(return_var_type0); + llvm::Type* el_llvm_type = get_type_from_ttype_t(asr_list->m_type, nullptr, m_storage, + is_array_type, is_malloc_array_type, is_list, m_dims, n_dims, a_kind, module); + int32_t type_size = -1; + if( LLVM::is_llvm_struct(asr_list->m_type) || + ASR::is_a(*asr_list->m_type) || + ASR::is_a(*asr_list->m_type) ) { + llvm::DataLayout data_layout(module); + type_size = data_layout.getTypeAllocSize(el_llvm_type); + } else { + type_size = a_kind; + } + std::string el_type_code = ASRUtils::get_type_code(asr_list->m_type); + return_type = list_api->get_list_type(el_llvm_type, el_type_code, type_size); + break; + } + case (ASR::ttypeType::Dict) : { + ASR::Dict_t* asr_dict = ASR::down_cast(return_var_type0); + std::string key_type_code = ASRUtils::get_type_code(asr_dict->m_key_type); + std::string value_type_code = ASRUtils::get_type_code(asr_dict->m_value_type); + + bool is_local_array_type = false, is_local_malloc_array_type = false; + bool is_local_list = false; + ASR::dimension_t* local_m_dims = nullptr; + ASR::storage_typeType local_m_storage = ASR::storage_typeType::Default; + int local_n_dims = 0, local_a_kind = -1; + + llvm::Type* key_llvm_type = get_type_from_ttype_t(asr_dict->m_key_type, + nullptr, local_m_storage, is_local_array_type, is_local_malloc_array_type, + is_local_list, local_m_dims, local_n_dims, local_a_kind, module); + llvm::Type* value_llvm_type = get_type_from_ttype_t(asr_dict->m_value_type, + nullptr, local_m_storage,is_local_array_type, is_local_malloc_array_type, + is_local_list, local_m_dims, local_n_dims, local_a_kind, module); + int32_t key_type_size = get_type_size(asr_dict->m_key_type, key_llvm_type, local_a_kind, module); + int32_t value_type_size = get_type_size(asr_dict->m_value_type, value_llvm_type, local_a_kind, module); + + set_dict_api(asr_dict); + + return_type = dict_api->get_dict_type(key_type_code, value_type_code, key_type_size,value_type_size, key_llvm_type, value_llvm_type); + break; + } + case (ASR::ttypeType::Set) : { + ASR::Set_t* asr_set = ASR::down_cast(return_var_type0); + std::string el_type_code = ASRUtils::get_type_code(asr_set->m_type); + + bool is_local_array_type = false, is_local_malloc_array_type = false; + bool is_local_list = false; + ASR::dimension_t* local_m_dims = nullptr; + ASR::storage_typeType local_m_storage = ASR::storage_typeType::Default; + int local_n_dims = 0, local_a_kind = -1; + + llvm::Type* el_llvm_type = get_type_from_ttype_t(asr_set->m_type, + nullptr, local_m_storage, is_local_array_type, is_local_malloc_array_type, + is_local_list, local_m_dims, local_n_dims, local_a_kind, module); + int32_t el_type_size = get_type_size(asr_set->m_type, el_llvm_type, local_a_kind, module); + + set_set_api(asr_set); + + return_type = set_api->get_set_type(el_type_code, el_type_size, el_llvm_type); + break; + } + default : + throw CodeGenError("Type not implemented " + std::to_string(return_var_type)); + } + } else { + return_type = llvm::Type::getVoidTy(context); + } + std::vector args = convert_args(x, module); + llvm::FunctionType *function_type = llvm::FunctionType::get( + return_type, args, false); + return function_type; + } + llvm::Type* LLVMUtils::get_type_from_ttype_t(ASR::ttype_t* asr_type, ASR::symbol_t *type_declaration, ASR::storage_typeType m_storage, bool& is_array_type, bool& is_malloc_array_type, bool& is_list, @@ -1147,6 +1376,27 @@ namespace LCompilers { v_type->m_dims, v_type->n_dims)); break; } + case ASR::array_physical_typeType::SIMDArray: { + llvm_type = llvm::VectorType::get(get_el_type(v_type->m_type, module), + ASRUtils::get_fixed_size_of_array(v_type->m_dims, v_type->n_dims), false); + break; + } + case ASR::array_physical_typeType::CharacterArraySinglePointer: { + if (ASRUtils::is_fixed_size_array(v_type->m_dims, v_type->n_dims)) { + llvm_type = llvm::ArrayType::get(character_type, + ASRUtils::get_fixed_size_of_array(v_type->m_dims, v_type->n_dims)); + break; + } else if (ASRUtils::is_dimension_empty(v_type->m_dims, v_type->n_dims)) { + // Treat it as a DescriptorArray + is_array_type = true; + llvm::Type* el_type = character_type; + llvm_type = arr_api->get_array_type(asr_type, el_type); + break; + } else { + LCOMPILERS_ASSERT(false); + break; + } + } default: { LCOMPILERS_ASSERT(false); } @@ -1267,6 +1517,7 @@ namespace LCompilers { break; } case (ASR::ttypeType::CPtr) : { + a_kind = 8; llvm_type = llvm::Type::getVoidTy(context)->getPointerTo(); break; } @@ -1281,9 +1532,14 @@ namespace LCompilers { break; } case (ASR::ttypeType::FunctionType) : { - ASR::Function_t* fn = ASR::down_cast( - ASRUtils::symbol_get_past_external(type_declaration)); - llvm_type = get_function_type(*fn, module)->getPointerTo(); + if( type_declaration ) { + ASR::Function_t* fn = ASR::down_cast( + ASRUtils::symbol_get_past_external(type_declaration)); + llvm_type = get_function_type(*fn, module)->getPointerTo(); + } else { + ASR::FunctionType_t* func_type = ASR::down_cast(asr_type); + llvm_type = get_function_type(func_type, module)->getPointerTo(); + } break; } default : @@ -1679,12 +1935,21 @@ namespace LCompilers { } break ; }; - case ASR::ttypeType::Allocatable: case ASR::ttypeType::Character: + case ASR::ttypeType::FunctionType: case ASR::ttypeType::CPtr: { LLVM::CreateStore(*builder, src, dest); break ; } + case ASR::ttypeType::Allocatable: { + ASR::Allocatable_t* alloc_type = ASR::down_cast(asr_type); + if( ASR::is_a(*alloc_type->m_type) ) { + lfortran_str_copy(dest, src, true, *module, *builder, context); + } else { + LLVM::CreateStore(*builder, src, dest); + } + break; + } case ASR::ttypeType::Tuple: { ASR::Tuple_t* tuple_type = ASR::down_cast(asr_type); tuple_api->tuple_deepcopy(src, dest, tuple_type, module, name2memidx); @@ -1736,7 +2001,7 @@ namespace LCompilers { } default: { throw LCompilersException("LLVMUtils::deepcopy isn't implemented for " + - ASRUtils::type_to_str_python(asr_type)); + ASRUtils::type_to_str(asr_type)); } } } diff --git a/src/libasr/codegen/llvm_utils.h b/src/libasr/codegen/llvm_utils.h index 904cbea..a4fdedf 100644 --- a/src/libasr/codegen/llvm_utils.h +++ b/src/libasr/codegen/llvm_utils.h @@ -96,6 +96,25 @@ namespace LCompilers { return builder.CreateCall(fn_printf, args); } + static inline llvm::Value* lfortran_str_copy(llvm::Value* dest, llvm::Value *src, bool is_allocatable, + llvm::Module &module, llvm::IRBuilder<> &builder, llvm::LLVMContext &context) { + std::string runtime_func_name = "_lfortran_strcpy"; + llvm::Function *fn = module.getFunction(runtime_func_name); + if (!fn) { + llvm::FunctionType *function_type = llvm::FunctionType::get( + llvm::Type::getVoidTy(context), { + llvm::Type::getInt8PtrTy(context)->getPointerTo(), + llvm::Type::getInt8PtrTy(context), + llvm::Type::getInt8Ty(context) + }, false); + fn = llvm::Function::Create(function_type, + llvm::Function::ExternalLinkage, runtime_func_name, module); + } + llvm::Value* free_string = llvm::ConstantInt::get( + llvm::Type::getInt8Ty(context), llvm::APInt(8, is_allocatable)); + return builder.CreateCall(fn, {dest, src, free_string}); + } + static inline void print_error(llvm::LLVMContext &context, llvm::Module &module, llvm::IRBuilder<> &builder, const std::vector &args) { @@ -282,6 +301,10 @@ namespace LCompilers { std::vector convert_args(const ASR::Function_t &x, llvm::Module* module); + llvm::FunctionType* get_function_type(ASR::FunctionType_t* x, llvm::Module* module); + + std::vector convert_args(ASR::FunctionType_t* x, llvm::Module* module); + llvm::Type* get_type_from_ttype_t(ASR::ttype_t* asr_type, ASR::symbol_t *type_declaration, ASR::storage_typeType m_storage, bool& is_array_type, bool& is_malloc_array_type, bool& is_list, diff --git a/src/libasr/compiler_tester/tester.py b/src/libasr/compiler_tester/tester.py index 35da61c..bd6d7e6 100644 --- a/src/libasr/compiler_tester/tester.py +++ b/src/libasr/compiler_tester/tester.py @@ -255,9 +255,27 @@ def do_update_reference(jo, jr, do): f_r = os.path.join(os.path.dirname(jr), do[f]) shutil.copyfile(f_o, f_r) +def do_verify_reference_hash(jr, dr, s): + for f in ["outfile", "stdout", "stderr"]: + if dr[f]: + f_r = os.path.join(os.path.dirname(jr), dr[f]) + temp = unl_loop_del(open(f_r, "rb").read()) + f_r_hash = hashlib.sha224(temp).hexdigest() + if (f_r_hash != dr[f + "_hash"]): + # This string builds up the error message. + # Print test name in red in the beginning. + # More information is added afterwards. + full_err_str = f"\n{(color(fg.red)+color(style.bold))}{s}{color(fg.reset)+color(style.reset)}\n" + full_err_str += "The generated hash for the reference file and its committed hash are different\n" + full_err_str += "Reference File: " + f_r + "\n" + full_err_str += "Reference Json File: " + jr + "\n" + full_err_str += "Reference File Hash Expected: " + f_r_hash + "\n" + full_err_str += "Reference File Hash Found: " + dr[f + "_hash"] + "\n" + raise RunException("Verifying reference hash failed." + + full_err_str) def run_test(testname, basename, cmd, infile, update_reference=False, - extra_args=None): + verify_hash=False, extra_args=None): """ Runs the test `cmd` and compare against reference results. @@ -274,6 +292,9 @@ def run_test(testname, basename, cmd, infile, update_reference=False, it exists and hash it. update_reference ... if True, it will copy the output into the reference directory as reference results, overwriting old ones + verify_hash ...... if True, it will check the hash in the committed + json file and the hash for the committed references + directory as reference results, overwriting old ones extra_args ......... Extra arguments to append to the command that are not part of the hash @@ -303,6 +324,11 @@ def run_test(testname, basename, cmd, infile, update_reference=False, f"The reference json file '{jr}' for {testname} does not exist") dr = json.load(open(jr)) + + if verify_hash: + do_verify_reference_hash(jr, dr, s) + return + if do != dr: # This string builds up the error message. Print test name in red in the beginning. # More information is added afterwards. @@ -340,6 +366,8 @@ def tester_main(compiler, single_test, is_lcompilers_executable_installed=False) parser = argparse.ArgumentParser(description=f"{compiler} Test Suite") parser.add_argument("-u", "--update", action="store_true", help="update all reference results") + parser.add_argument("-vh", "--verify-hash", action="store_true", + help="Verify all reference hashes") parser.add_argument("-l", "--list", action="store_true", help="list all tests") parser.add_argument("-t", "--test", @@ -368,6 +396,7 @@ def tester_main(compiler, single_test, is_lcompilers_executable_installed=False) help="Turn off colored tests output") args = parser.parse_args() update_reference = args.update + verify_hash = args.verify_hash list_tests = args.list specific_tests = list( itertools.chain.from_iterable( @@ -410,6 +439,7 @@ def tester_main(compiler, single_test, is_lcompilers_executable_installed=False) if 'extrafiles' in test: single_test(test, update_reference=update_reference, + verify_hash=verify_hash, specific_backends=specific_backends, excluded_backends=excluded_backends, verbose=verbose, @@ -423,6 +453,7 @@ def tester_main(compiler, single_test, is_lcompilers_executable_installed=False) for test in filtered_tests: single_test(test, update_reference=update_reference, + verify_hash=verify_hash, specific_backends=specific_backends, excluded_backends=excluded_backends, verbose=verbose, @@ -435,6 +466,7 @@ def tester_main(compiler, single_test, is_lcompilers_executable_installed=False) single_tester_partial_args = partial( single_test, update_reference=update_reference, + verify_hash=verify_hash, specific_backends=specific_backends, excluded_backends=excluded_backends, verbose=verbose, @@ -452,6 +484,13 @@ def tester_main(compiler, single_test, is_lcompilers_executable_installed=False) if update_reference: log.info("Test references updated.") + elif verify_hash: + if no_color: + log.info("Test references hash verfied.") + else: + log.info( + f"{(color(fg.green) + color(style.bold))}Test references hash verfied." + f"{color(fg.reset) + color(style.reset)}") else: if no_color: log.info("TESTS PASSED") diff --git a/src/libasr/config.h.in b/src/libasr/config.h.in index 292b593..f2e453e 100644 --- a/src/libasr/config.h.in +++ b/src/libasr/config.h.in @@ -6,6 +6,9 @@ /* LFortran version */ #cmakedefine LFORTRAN_VERSION "@LFORTRAN_VERSION@" +#define LFORTRAN_MAJOR @CMAKE_PROJECT_VERSION_MAJOR@ +#define LFORTRAN_MINOR @CMAKE_PROJECT_VERSION_MINOR@ +#define LFORTRAN_PATCHLEVEL @CMAKE_PROJECT_VERSION_PATCH@ /* Define if LLVM is enabled */ #cmakedefine HAVE_LFORTRAN_LLVM diff --git a/src/libasr/gen_pass.py b/src/libasr/gen_pass.py index e88114f..abccd1c 100644 --- a/src/libasr/gen_pass.py +++ b/src/libasr/gen_pass.py @@ -1,5 +1,6 @@ passes = [ "replace_arr_slice", + "replace_function_call_in_declaration", "replace_array_op", "replace_class_constructor", "dead_code_removal", @@ -8,6 +9,7 @@ "replace_flip_sign", "replace_fma", "replace_for_all", + "while_else", "wrap_global_stmts", "replace_implied_do_loops", "replace_init_expr", @@ -32,7 +34,8 @@ "update_array_dim_intrinsic_calls", "replace_where", "unique_symbols", - "insert_deallocate" + "insert_deallocate", + "promote_allocatable_to_nonallocatable" ] diff --git a/src/libasr/intrinsic_func_registry_util_gen.py b/src/libasr/intrinsic_func_registry_util_gen.py new file mode 100644 index 0000000..32a9f49 --- /dev/null +++ b/src/libasr/intrinsic_func_registry_util_gen.py @@ -0,0 +1,749 @@ +import sys +import os + +intrinsic_funcs_args = { + "Kind": [ + { + "args": [("int",), ("real",), ("bool",), ("char",), (("complex",))], + "return": "int32" + }, + ], + "FMA": [ + { + "args": [("real", "real", "real")], + "ret_type_arg_idx": 0 + } + ], + "FlipSign": [ + { + "args": [("int", "real")], + "ret_type_arg_idx": 1 + } + ], + "FloorDiv": [ + { + "args": [("int", "int"), ("uint", "uint"), ("real", "real"), ("bool", "bool")], + "ret_type_arg_idx": 0 + }, + ], + "Mod": [ + { + "args": [("int", "int"), ("real", "real")], + "ret_type_arg_idx": 0 + }, + ], + "Trailz": [ + { + "args": [("int",)], + "ret_type_arg_idx": 0 + }, + ], + "BesselJ0": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + }, + ], + "BesselJ1": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + }, + ], + "BesselY0": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + }, + ], + "Mvbits": [ + { + "args": [("int", "int", "int", "int", "int")], + "ret_type_arg_idx": 3 + }, + ], + "Leadz": [ + { + "args": [("int",)], + "ret_type_arg_idx": 0 + }, + ], + "ToLowerCase": [ + { + "args": [("char",)], + "ret_type_arg_idx": 0 + }, + ], + "Hypot": [ + { + "args": [("real", "real")], + "ret_type_arg_idx": 0 + } + ], + "SelectedIntKind": [ + { + "args": [("int",)], + "return": "int32" + } + ], + "SelectedRealKind": [ + { + "args": [("int", "int", "int")], + "return": "int32" + } + ], + "SelectedCharKind": [ + { + "args": [("char",)], + "return": "int32" + } + ], + "Digits": [ + { + "args": [("int",), ("real",)], + "return": "int32" + }, + ], + "Repeat": [ + { + "args": [("char", "int")], + "ret_type_arg_idx": 0 + } + ], + "StringContainsSet": [ + { + "args": [("char", "char", "bool", "int")], + "ret_type_arg_idx": 3 + } + ], + "StringFindSet": [ + { + "args": [("char", "char", "bool", "int")], + "ret_type_arg_idx": 3 + } + ], + "SubstrIndex": [ + { + "args": [("char", "char", "bool", "int")], + "ret_type_arg_idx": 3 + } + ], + "MinExponent": [ + { + "args": [("real",)], + "return": "int32" + } + ], + "MaxExponent": [ + { + "args": [("real",)], + "return": "int32" + } + ], + "Partition": [ + { + "args": [("char", "char")], + "ret_type_arg_idx": 0 + } + ], + "ListReverse": [ + { + "args": [("list",)], + "return": "nullptr" + } + ], + "ListReserve": [ + { + "args": [("list", "int")], + "return": "nullptr" + } + ], + "Sign": [ + { + "args": [("int", "int"), ("real", "real")], + "ret_type_arg_idx": 0 + }, + ], + "Radix": [ + { + "args": [("int",), ("real",)], + "return": "int32" + }, + ], + "Adjustl": [ + { + "args": [("char",)], + "return": "character(-1)" + } + ], + "Adjustr": [ + { + "args": [("char",)], + "return": "character(-1)" + } + ], + "Aint": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0, + "kind_arg": True + } + ], + "Nint": [ + { + "args": [("real",)], + "return": "int32", + "kind_arg": True + } + ], + "Anint": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0, + "kind_arg": True + } + ], + "Floor": [ + { + "args": [("real",)], + "return": "int32", + "kind_arg": True + } + ], + "Ceiling": [ + { + "args": [("real",)], + "return": "int32", + "kind_arg": True + } + ], + "Sqrt": [ + { + "args": [("real",), ("complex",)], + "ret_type_arg_idx": 0 + }, + ], + "Sngl": [ + { + "args": [("real",)], + "return": "real32" + } + ], + "SignFromValue": [ + { + "args": [("int", "int"), ("real", "real")], + "ret_type_arg_idx": 0 + }, + ], + "Ifix": [ + { + "args": [("real",)], + "return": "int32" + } + ], + "Idint": [ + { + "args": [("real",)], + "return": "int32" + } + ], + "Ishft": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Bgt": [ + { + "args": [("int", "int")], + "return": "logical" + }, + ], + "Blt": [ + { + "args": [("int", "int")], + "return": "logical" + }, + ], + "Bge": [ + { + "args": [("int", "int")], + "return": "logical" + }, + ], + "Ble": [ + { + "args": [("int", "int")], + "return": "logical" + }, + ], + "Lgt": [ + { + "args": [("char", "char")], + "return": "logical" + }, + ], + "Llt": [ + { + "args": [("char", "char")], + "return": "logical" + }, + ], + "Lge": [ + { + "args": [("char", "char")], + "return": "logical" + }, + ], + "Lle": [ + { + "args": [("char", "char")], + "return": "logical" + }, + ], + "Not": [ + { + "args": [("int",)], + "ret_type_arg_idx": 0 + }, + ], + "Iand": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Ior": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Ieor": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Ibclr": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Ibset": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Btest": [ + { + "args": [("int", "int")], + "return": "logical" + }, + ], + "Ibits": [ + { + "args": [("int", "int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Shiftr": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + } + ], + "Rshift": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + } + ], + "Shiftl": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + } + ], + "Aimag": [ + { + "args": [("complex",)], + "return": "real32", + "kind_arg": True + }, + ], + "Rank": [ + { + "args": [("any",)], + "return": "int32" + } + ], + "Range": [ + { + "args": [("int",), ("real",), ("complex",)], + "return": "int32" + }, + ], + "Epsilon": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + } + ], + "Precision": [ + { + "args": [("real",), ("complex",)], + "return": "int32" + } + ], + "Tiny": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + } + ], + "Conjg": [ + { + "args": [("complex",)], + "ret_type_arg_idx": 0 + }, + ], + "Scale": [ + { + "args": [("real", "int")], + "ret_type_arg_idx": 0 + } + ], + "Huge": [ + { + "args": [("int",), ("real",)], + "ret_type_arg_idx": 0 + } + ], + "Dprod": [ + { + "args": [("real", "real")], + "return": "real64" + } + ], + "Dim": [ + { + "args": [("int", "int"), ("real", "real")], + "ret_type_arg_idx": 0 + }, + ], + "Maskl": [ + { + "args": [("int",)], + "return": "int32", + "kind_arg": True + } + ], + "Maskr": [ + { + "args": [("int",)], + "return": "int32", + "kind_arg": True + } + ], + "Ishftc": [ + { + "args": [("int", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Ichar": [ + { + "args": [("char",)], + "return": "int32", + "kind_arg": True + }, + ], + "Char": [ + { + "args": [("int",)], + "return": "character(1)", + "kind_arg": True + } + ], + "Exponent": [ + { + "args": [("real",)], + "return": "int32", + }, + ], + "Fraction": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + }, + ], + "SetExponent": [ + { + "args": [("real", "int")], + "ret_type_arg_idx": 0 + }, + ], + "Rrspacing": [ + { + "args": [("real",)], + "ret_type_arg_idx": 0 + }, + ], + "Dshiftl": [ + { + "args": [("int", "int", "int",)], + "ret_type_arg_idx": 0 + }, + ], + "Popcnt": [ + { + "args": [("int",)], + "return": "int32", + }, + ], + "Poppar": [ + { + "args": [("int",)], + "return": "int32", + }, + ], + +} + +skip_create_func = ["Partition"] +compile_time_only_fn = [ + "Epsilon", + "Radix", + "Range", + "Precision", + "Rank", + "Tiny", + "Huge", +] + +type_to_asr_type_check = { + "any": "!ASR::is_a", + "int": "is_integer", + "uint": "is_unsigned_integer", + "real": "is_real", + "bool": "is_logical", + "char": "is_character", + "complex": "is_complex", + "dict": "ASR::is_a", + "list": "ASR::is_a", + "tuple": "ASR::is_a" +} + +intrinsic_funcs_ret_type = { + "Kind": ["int"], + "Partition": ["tuple"], + "ListReverse": ["null"], + "ListReserve": [ "null"], + "Radix": ["int"], +} + +src = "" +indent = " " + +def compute_arg_types(indent, no_of_args, args_arr): + global src + for i in range(no_of_args): + src += indent + f"ASR::ttype_t *arg_type{i} = ASRUtils::type_get_past_const(ASRUtils::expr_type({args_arr}[{i}]));\n" + +def compute_arg_condition(no_of_args, args_lists): + condition = [] + cond_in_msg = [] + for arg_list in args_lists: + subcond = [] + subcond_in_msg = [] + for i in range(no_of_args): + arg = arg_list[i] + subcond.append(f"{type_to_asr_type_check[arg]}(*arg_type{i})") + subcond_in_msg.append(arg) + condition.append(" && ".join(subcond)) + cond_in_msg.append(", ".join(subcond_in_msg)) + return (f"({') || ('.join(condition)})", f"({') or ('.join(cond_in_msg)})") + +def add_verify_arg_type_src(func_name): + global src + arg_infos = intrinsic_funcs_args[func_name] + no_of_args_msg = "" + for i, arg_info in enumerate(arg_infos): + args_lists = arg_info["args"] + no_of_args = len(args_lists[0]) + no_of_args_msg += " or " if i > 0 else "" + no_of_args_msg += f"{no_of_args}" + else_if = "else if" if i > 0 else "if" + src += 2 * indent + f"{else_if} (x.n_args == {no_of_args}) " + " {\n" + src += 3 * indent + f'ASRUtils::require_impl(x.m_overload_id == {i}, "Overload Id for {func_name} expected to be {i}, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics);\n' + compute_arg_types(3 * indent, no_of_args, "x.m_args") + condition, cond_in_msg = compute_arg_condition(no_of_args, args_lists) + src += 3 * indent + f'ASRUtils::require_impl({condition}, "Unexpected args, {func_name} expects {cond_in_msg} as arguments", x.base.base.loc, diagnostics);\n' + src += 2 * indent + "}\n" + src += 2 * indent + "else {\n" + src += 3 * indent + f'ASRUtils::require_impl(false, "Unexpected number of args, {func_name} takes {no_of_args_msg} arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics);\n' + src += 2 * indent + "}\n" + +def add_verify_return_type_src(func_name): + if func_name not in intrinsic_funcs_ret_type.keys(): + return "" + global src + ret_type_cond = "" + ret_type_cond_in_msg = "" + for i, ret_type in enumerate(intrinsic_funcs_ret_type[func_name]): + if ret_type == "null": + ret_type_cond += f"x.m_type == nullptr" + else: + ret_type_cond += f"{type_to_asr_type_check[ret_type]}(*x.m_type)" + ret_type_cond_in_msg += f"{ret_type}" + if i < len(intrinsic_funcs_ret_type[func_name]) - 1: + ret_type_cond += " || " + ret_type_cond_in_msg += " or " + src += 2 * indent + f'ASRUtils::require_impl({ret_type_cond}, "Unexpected return type, {func_name} expects `{ret_type_cond_in_msg}` as return type", x.base.base.loc, diagnostics);\n' + +def add_create_func_arg_type_src(func_name): + global src + arg_infos = intrinsic_funcs_args[func_name] + no_of_args_msg = "" + for i, arg_info in enumerate(arg_infos): + args_lists = arg_info["args"] + kind_arg = arg_info.get("kind_arg", False) + no_of_args = len(args_lists[0]) + no_of_args_msg += " or " if i > 0 else "" + no_of_args_msg += f"{no_of_args + int(kind_arg)}" + else_if = "else if" if i > 0 else "if" + src += 2 * indent + f"{else_if} (args.size() == {no_of_args + int(kind_arg)}) " + " {\n" + compute_arg_types(3 * indent, no_of_args, "args") + condition, cond_in_msg = compute_arg_condition(no_of_args, args_lists) + src += 3 * indent + f'if(!({condition}))' + ' {\n' + src += 4 * indent + f'append_error(diag, "Unexpected args, {func_name} expects {cond_in_msg} as arguments", loc);\n' + src += 4 * indent + f'return nullptr;\n' + src += 3 * indent + '}\n' + src += 2 * indent + "}\n" + src += 2 * indent + "else {\n" + src += 3 * indent + f'append_error(diag, "Unexpected number of args, {func_name} takes {no_of_args_msg} arguments, found " + std::to_string(args.size()), loc);\n' + src += 3 * indent + f'return nullptr;\n' + src += 2 * indent + "}\n" + + +def add_create_func_return_src(func_name): + global src, indent + arg_infos = intrinsic_funcs_args[func_name] + args_lists = arg_infos[0]["args"] + no_of_args = len(args_lists[0]) + ret_type_val = arg_infos[0].get("return", None) + ret_type_arg_idx = arg_infos[0].get("ret_type_arg_idx", None) + if ret_type_val: + ret_type = ret_type_val + else: + src += indent * 2 + "ASRUtils::ExprStmtDuplicator expr_duplicator(al);\n" + src += indent * 2 + "expr_duplicator.allow_procedure_calls = true;\n" + src += indent * 2 + f"ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[{ret_type_arg_idx}]));\n" + ret_type = "type_" + kind_arg = arg_infos[0].get("kind_arg", False) + src += indent * 2 + f"ASR::ttype_t *return_type = {ret_type};\n" + if kind_arg: + src += indent * 2 + "if ( args[1] != nullptr ) {\n" + src += indent * 3 + "int kind = -1;\n" + src += indent * 3 + "if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) {\n" + src += indent * 4 + f'append_error(diag, "`kind` argument of the `{func_name}` function must be a scalar Integer constant", args[1]->base.loc);\n' + src += indent * 4 + "return nullptr;\n" + src += indent * 3 + "}\n" + src += indent * 3 + "set_kind_to_ttype_t(return_type, kind);\n" + src += indent * 2 + "}\n" + src += indent * 2 + "ASR::expr_t *m_value = nullptr;\n" + src += indent * 2 + f"Vec m_args; m_args.reserve(al, {no_of_args});\n" + for _i in range(no_of_args): + src += indent * 2 + f"m_args.push_back(al, args[{_i}]);\n" + if func_name in compile_time_only_fn: + src += indent * 2 + f"return_type = ASRUtils::extract_type(return_type);\n" + src += indent * 2 + f"m_value = eval_{func_name}(al, loc, return_type, args, diag);\n" + src += indent * 2 + "return ASR::make_TypeInquiry_t(al, loc, "\ + f"static_cast(IntrinsicElementalFunctions::{func_name}), "\ + "ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value);\n" + + else: + src += indent * 2 + "if (all_args_evaluated(m_args)) {\n" + src += indent * 3 + f"Vec args_values; args_values.reserve(al, {no_of_args});\n" + for _i in range(no_of_args): + src += indent * 3 + f"args_values.push_back(al, expr_value(m_args[{_i}]));\n" + src += indent * 3 + f"m_value = eval_{func_name}(al, loc, return_type, args_values, diag);\n" + src += indent * 2 + "}\n" + if "null" in intrinsic_funcs_ret_type.get(func_name, []): + src += indent * 2 + f"return ASR::make_Expr_t(al, loc, ASRUtils::EXPR(ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::{func_name}), m_args.p, m_args.n, 0, return_type, m_value)));\n" + else: + src += indent * 2 + f"return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::{func_name}), m_args.p, m_args.n, 0, return_type, m_value);\n" + +def gen_verify_args(func_name): + global src + src += indent + R"static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) {" + "\n" + add_verify_arg_type_src(func_name) + if func_name in compile_time_only_fn: + src += indent * 2 + 'ASRUtils::require_impl(x.m_value, '\ + f'"Missing compile time value, `{func_name}` intrinsic output must '\ + 'be computed during compile time", x.base.base.loc, diagnostics);\n' + add_verify_return_type_src(func_name) + src += indent + "}\n\n" + +def gen_create_function(func_name): + global src + src += indent + Rf"static inline ASR::asr_t* create_{func_name}(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) " + "{\n" + add_create_func_arg_type_src(func_name) + add_create_func_return_src(func_name) + src += indent + "}\n" + + +def get_registry_funcs_src(): + global src + for func_name in intrinsic_funcs_args.keys(): + src += f"namespace {func_name}" + " {\n\n" + gen_verify_args(func_name) + + if func_name not in skip_create_func: + gen_create_function(func_name) + src += "}\n\n" + return src + + +HEAD = """#ifndef LIBASR_PASS_INTRINSIC_FUNC_REG_UTIL_H +#define LIBASR_PASS_INTRINSIC_FUNC_REG_UTIL_H + +#include + +namespace LCompilers { + +namespace ASRUtils { + +""" + +FOOT = """ +} // namespace ASRUtil + +} // namespace LCompilers + +#endif // LIBASR_PASS_INTRINSIC_FUNC_REG_UTIL_H +""" +def main(argv): + if len(argv) == 2: + out_file = argv[1] + elif len(argv) == 1: + print("Assuming default values of intrinsic_function_registry_util.h") + here = os.path.dirname(__file__) + pass_dir = os.path.join(here, "pass") + out_file = os.path.join(pass_dir, "intrinsic_function_registry_util.h") + else: + print("invalid arguments") + return 2 + fp = open(out_file, "w", encoding="utf-8") + try: + fp.write(HEAD) + fp.write(get_registry_funcs_src()) + fp.write(FOOT) + finally: + fp.close() + +if __name__ == "__main__": + sys.exit(main(sys.argv)) diff --git a/src/libasr/modfile.cpp b/src/libasr/modfile.cpp index d2c7501..25864da 100644 --- a/src/libasr/modfile.cpp +++ b/src/libasr/modfile.cpp @@ -7,7 +7,6 @@ #include #include - namespace LCompilers { const std::string lfortran_modfile_type_string = "LCompilers Modfile"; @@ -92,7 +91,6 @@ ASR::TranslationUnit_t* load_modfile(Allocator &al, const std::string &s, std::string asr_binary; load_serialised_asr(s, asr_binary); ASR::asr_t *asr = deserialize_asr(al, asr_binary, load_symtab_id, symtab); - ASR::TranslationUnit_t *tu = ASR::down_cast2(asr); return tu; } diff --git a/src/libasr/pass/arr_slice.cpp b/src/libasr/pass/arr_slice.cpp index 38e7979..45cfef3 100644 --- a/src/libasr/pass/arr_slice.cpp +++ b/src/libasr/pass/arr_slice.cpp @@ -155,7 +155,7 @@ class ReplaceArraySection: public ASR::BaseExprReplacer { const_1, int_type, nullptr)); ASR::stmt_t* assign_stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, x->base.base.loc, idx_vars_target[i], inc_expr, nullptr)); doloop_body.push_back(al, assign_stmt); - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, x->base.base.loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, x->base.base.loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } int a_kind = ASRUtils::extract_kind_from_ttype_t(ASRUtils::expr_type(idx_vars_target[0])); ASR::ttype_t* int_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x->base.base.loc, a_kind)); diff --git a/src/libasr/pass/array_op.cpp b/src/libasr/pass/array_op.cpp index 2593bcb..ee31377 100644 --- a/src/libasr/pass/array_op.cpp +++ b/src/libasr/pass/array_op.cpp @@ -132,8 +132,13 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { head.m_end = result_ubound[j]; head.m_increment = result_inc[j]; } else { - head.m_start = PassUtils::get_bound(result_var, i + 1, "lbound", al); - head.m_end = PassUtils::get_bound(result_var, i + 1, "ubound", al); + ASR::expr_t* var = result_var; + if (ASR::is_a(*result_var)) { + ASR::ComplexConstructor_t* cc = ASR::down_cast(result_var); + var = cc->m_re; + } + head.m_start = PassUtils::get_bound(var, i + 1, "lbound", al); + head.m_end = PassUtils::get_bound(var, i + 1, "ubound", al); head.m_increment = nullptr; } head.loc = head.m_v->base.loc; @@ -171,10 +176,15 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { doloop_body.push_back(al, assign_stmt2); } } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } if( var_rank > 0 ) { - ASR::expr_t* idx_lb = PassUtils::get_bound(op_expr1, 1, "lbound", al); + ASR::expr_t* expr = op_expr1; + if (ASR::is_a(*op_expr1)) { + ASR::ComplexConstructor_t* cc = ASR::down_cast(op_expr1); + expr = cc->m_re; + } + ASR::expr_t* idx_lb = PassUtils::get_bound(expr, 1, "lbound", al); ASR::stmt_t* set_to_one = ASRUtils::STMT(ASR::make_Assignment_t(al, loc, idx_vars_value1[0], idx_lb, nullptr)); pass_result.push_back(al, set_to_one); @@ -207,7 +217,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { } else { doloop_body.push_back(al, doloop); } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } pass_result.push_back(al, doloop); } @@ -268,7 +278,15 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { [=, &idx_vars_value, &idx_vars, &doloop_body]() { ASR::expr_t* ref = nullptr; if( var_rank > 0 ) { - ref = PassUtils::create_array_ref(*current_expr, idx_vars_value, al, current_scope); + if (ASR::is_a(**current_expr)) { + ASR::ComplexConstructor_t* cc = ASR::down_cast(*current_expr); + ASR::expr_t* re = PassUtils::create_array_ref(cc->m_re, idx_vars_value, al, current_scope); + ASR::expr_t* im = PassUtils::create_array_ref(cc->m_im, idx_vars_value, al, current_scope); + ref = ASRUtils::EXPR(ASR::make_ComplexConstructor_t(al, loc, re, im, cc->m_type, cc->m_value)); + *current_expr = ref; + } else { + ref = PassUtils::create_array_ref(*current_expr, idx_vars_value, al, current_scope); + } } else { ref = *current_expr; } @@ -282,7 +300,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { use_custom_loop_params = false; } - #define allocate_result_var(op_arg, op_dims_arg, op_n_dims_arg, result_var_created) if( ASR::is_a(*ASRUtils::expr_type(result_var)) || \ + #define allocate_result_var(op_arg, op_dims_arg, op_n_dims_arg, result_var_created, reset_bounds) if( ASR::is_a(*ASRUtils::expr_type(result_var)) || \ ASR::is_a(*ASRUtils::expr_type(result_var)) ) { \ bool is_dimension_empty = false; \ for( int i = 0; i < op_n_dims_arg; i++ ) { \ @@ -291,6 +309,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { break; \ } \ } \ + ASR::ttype_t* int32_type = ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)); \ Vec alloc_args; \ alloc_args.reserve(al, 1); \ if( !is_dimension_empty ) { \ @@ -310,9 +329,18 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { for( int i = 0; i < op_n_dims_arg; i++ ) { \ ASR::dimension_t alloc_dim; \ alloc_dim.loc = loc; \ - alloc_dim.m_start = PassUtils::get_bound(op_arg, i + 1, "lbound", al); \ - alloc_dim.m_length = ASRUtils::compute_length_from_start_end(al, alloc_dim.m_start, \ - PassUtils::get_bound(op_arg, i + 1, "ubound", al)); \ + if( reset_bounds && result_var_created ) { \ + alloc_dim.m_start = make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, 1, 4, loc); \ + } else { \ + alloc_dim.m_start = PassUtils::get_bound(op_arg, i + 1, "lbound", al); \ + alloc_dim.m_start = CastingUtil::perform_casting(alloc_dim.m_start, \ + int32_type, al, loc); \ + } \ + ASR::expr_t* lbound = PassUtils::get_bound(op_arg, i + 1, "lbound", al); \ + lbound = CastingUtil::perform_casting(lbound, int32_type, al, loc); \ + ASR::expr_t* ubound = PassUtils::get_bound(op_arg, i + 1, "ubound", al); \ + ubound = CastingUtil::perform_casting(ubound, int32_type, al, loc); \ + alloc_dim.m_length = ASRUtils::compute_length_from_start_end(al, lbound, ubound); \ alloc_dims.push_back(al, alloc_dim); \ } \ ASR::alloc_arg_t alloc_arg; \ @@ -360,7 +388,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { result_var_type, al, current_scope); result_counter += 1; if( allocate ) { - allocate_result_var(arr_expr, arr_expr_dims, arr_expr_n_dims, true); + allocate_result_var(arr_expr, arr_expr_dims, arr_expr_n_dims, true, false); } } @@ -460,7 +488,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { al, loc, idx_vars_value[i], inc_expr, nullptr)); doloop_body.push_back(al, assign_stmt); } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } if( ASRUtils::is_array(ASRUtils::expr_type(op_expr)) ) { ASR::expr_t* idx_lb = PassUtils::get_bound(op_expr, 1, "lbound", al); @@ -505,7 +533,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { } else { doloop_body.push_back(al, doloop); } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } pass_result.push_back(al, doloop); } @@ -667,8 +695,9 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { x_dims.reserve(al, x->n_args); const Location& loc = x->base.base.loc; ASRUtils::ASRBuilder builder(al, loc); + ASR::ttype_t* int32_type = ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)); ASR::expr_t* i32_one = ASRUtils::EXPR(ASR::make_IntegerConstant_t( - al, loc, 1, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))); + al, loc, 1, int32_type)); Vec empty_dims; empty_dims.reserve(al, x->n_args); for( size_t i = 0; i < x->n_args; i++ ) { @@ -705,9 +734,16 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { length_value = make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, ((const_end - const_start)/const_step) + 1, 4, loc); } + + ASR::expr_t* m_right = x->m_args[i].m_right; + ASR::expr_t* m_left = x->m_args[i].m_left; + ASR::expr_t* m_step = x->m_args[i].m_step; + m_right = CastingUtil::perform_casting(m_right, int32_type, al, loc); + m_left = CastingUtil::perform_casting(m_left, int32_type, al, loc); + m_step = CastingUtil::perform_casting(m_step, int32_type, al, loc); x_dim.m_length = builder.ElementalAdd(builder.ElementalDiv( - builder.ElementalSub(x->m_args[i].m_right, x->m_args[i].m_left, loc), - x->m_args[i].m_step, loc), i32_one, loc, length_value); + builder.ElementalSub(m_right, m_left, loc), + m_step, loc), i32_one, loc, length_value); x_dims.push_back(al, x_dim); } } @@ -716,16 +752,25 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { op_n_dims = x_dims.size(); } - ASR::ttype_t* x_m_type = ASRUtils::TYPE(ASR::make_Pointer_t(al, loc, - ASRUtils::type_get_past_allocatable(ASRUtils::duplicate_type(al, - ASRUtils::type_get_past_pointer(x->m_type), &empty_dims)))); - + ASR::ttype_t* x_m_type; + if (op_expr && ASRUtils::is_simd_array(op_expr)) { + x_m_type = ASRUtils::expr_type(op_expr); + } else { + x_m_type = ASRUtils::TYPE(ASR::make_Pointer_t(al, loc, + ASRUtils::type_get_past_allocatable(ASRUtils::duplicate_type(al, + ASRUtils::type_get_past_pointer(x->m_type), &empty_dims)))); + } ASR::expr_t* array_section_pointer = PassUtils::create_var( result_counter, "_array_section_pointer_", loc, x_m_type, al, current_scope); result_counter += 1; - pass_result.push_back(al, ASRUtils::STMT(ASRUtils::make_Associate_t_util( - al, loc, array_section_pointer, *current_expr))); + if (op_expr && ASRUtils::is_simd_array(op_expr)) { + pass_result.push_back(al, ASRUtils::STMT(ASR::make_Assignment_t( + al, loc, array_section_pointer, *current_expr, nullptr))); + } else { + pass_result.push_back(al, ASRUtils::STMT(ASRUtils::make_Associate_t_util( + al, loc, array_section_pointer, *current_expr))); + } *current_expr = array_section_pointer; // Might get used in other replace_* methods as well. @@ -740,6 +785,33 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { template void replace_ArrayOpCommon(T* x, std::string res_prefix) { + bool is_left_simd = ASRUtils::is_simd_array(x->m_left); + bool is_right_simd = ASRUtils::is_simd_array(x->m_right); + if ( is_left_simd && is_right_simd ) { + return; + } else if ( ( is_left_simd && !is_right_simd) || + (!is_left_simd && is_right_simd) ) { + ASR::expr_t** current_expr_copy = current_expr; + ASR::expr_t* op_expr_copy = op_expr; + if (is_left_simd) { + // Replace ArraySection, case: a = a + b(:4) + if (ASR::is_a(*x->m_right)) { + current_expr = &(x->m_right); + op_expr = x->m_left; + this->replace_expr(x->m_right); + } + } else { + // Replace ArraySection, case: a = b(:4) + a + if (ASR::is_a(*x->m_left)) { + current_expr = &(x->m_left); + op_expr = x->m_right; + this->replace_expr(x->m_left); + } + } + current_expr = current_expr_copy; + op_expr = op_expr_copy; + return; + } const Location& loc = x->base.base.loc; bool current_status = use_custom_loop_params; use_custom_loop_params = false; @@ -828,7 +900,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { result_var_type, al, current_scope); result_counter += 1; if( allocate ) { - allocate_result_var(left, left_dims, rank_left, true); + allocate_result_var(left, left_dims, rank_left, true, true); } new_result_var_created = true; } @@ -894,7 +966,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { result_var_type, al, current_scope); result_counter += 1; if( allocate ) { - allocate_result_var(arr_expr, arr_expr_dims, arr_expr_n_dims, true); + allocate_result_var(arr_expr, arr_expr_dims, arr_expr_n_dims, true, true); } new_result_var_created = true; } @@ -948,11 +1020,31 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { 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(*x->m_arg) ) { + *current_expr = x->m_arg; + ASR::ArrayReshape_t* array_reshape_t = ASR::down_cast(x->m_arg); + ASR::array_physical_typeType array_reshape_ptype = ASRUtils::extract_physical_type(array_reshape_t->m_type); + Vec m_dims_vec; + ASR::dimension_t* m_dims; + size_t n_dims = ASRUtils::extract_dimensions_from_ttype(ASRUtils::expr_type(array_reshape_t->m_array), m_dims); + m_dims_vec.from_pointer_n(m_dims, n_dims); + array_reshape_t->m_array = ASRUtils::EXPR(ASR::make_Cast_t(al, x->base.base.loc, + array_reshape_t->m_array, x->m_kind, ASRUtils::duplicate_type(al, x->m_type, &m_dims_vec, + array_reshape_ptype, true), nullptr)); + n_dims = ASRUtils::extract_dimensions_from_ttype(array_reshape_t->m_type, m_dims); + m_dims_vec.from_pointer_n(m_dims, n_dims); + array_reshape_t->m_type = ASRUtils::duplicate_type(al, x->m_type, &m_dims_vec, array_reshape_ptype, true); + x_ = ASR::down_cast(array_reshape_t->m_array); + current_expr = &array_reshape_t->m_array; + result_var = nullptr; + } ASR::expr_t* result_var_copy = result_var; result_var = nullptr; - BaseExprReplacer::replace_Cast(x); + BaseExprReplacer::replace_Cast(x_); result_var = result_var_copy; - ASR::expr_t* tmp_val = x->m_arg; + ASR::expr_t* tmp_val = x_->m_arg; bool is_arg_array = PassUtils::is_array(tmp_val); bool is_result_var_array = result_var && PassUtils::is_array(result_var); @@ -961,12 +1053,40 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { return ; } - const Location& loc = x->base.base.loc; if( result_var == nullptr ) { - PassUtils::fix_dimension(x, tmp_val); + PassUtils::fix_dimension(x_, tmp_val); result_var = PassUtils::create_var(result_counter, std::string("_implicit_cast_res"), loc, *current_expr, al, current_scope); + ASR::dimension_t* allocate_dims = nullptr; + int n_dims = ASRUtils::extract_dimensions_from_ttype(x_->m_type, allocate_dims); + allocate_result_var(x_->m_arg, allocate_dims, n_dims, true, true); result_counter += 1; + } else { + ASR::ttype_t* result_var_type = ASRUtils::expr_type(result_var); + if( realloc_lhs && is_arg_array && ASRUtils::is_allocatable(result_var_type)) { + Vec result_var_m_dims; + size_t result_var_n_dims = ASRUtils::extract_n_dims_from_ttype(result_var_type); + result_var_m_dims.reserve(al, result_var_n_dims); + ASR::alloc_arg_t result_alloc_arg; + result_alloc_arg.loc = loc; + result_alloc_arg.m_a = result_var; + for( size_t i = 0; i < result_var_n_dims; i++ ) { + ASR::dimension_t result_var_dim; + result_var_dim.loc = loc; + result_var_dim.m_start = make_ConstantWithKind( + make_IntegerConstant_t, make_Integer_t, 1, 4, loc); + result_var_dim.m_length = ASRUtils::get_size(tmp_val, i + 1, al); + result_var_m_dims.push_back(al, result_var_dim); + } + result_alloc_arg.m_dims = result_var_m_dims.p; + result_alloc_arg.n_dims = result_var_n_dims; + result_alloc_arg.m_len_expr = nullptr; + result_alloc_arg.m_type = nullptr; + Vec alloc_result_args; alloc_result_args.reserve(al, 1); + alloc_result_args.push_back(al, result_alloc_arg); + pass_result.push_back(al, ASRUtils::STMT(ASR::make_ReAlloc_t( + al, loc, alloc_result_args.p, 1))); + } } int n_dims = PassUtils::get_rank(result_var); @@ -982,7 +1102,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { } ASR::expr_t* res = PassUtils::create_array_ref(result_var, idx_vars, al, current_scope); ASR::ttype_t* x_m_type = ASRUtils::duplicate_type_without_dims( - al, x->m_type, x->m_type->base.loc); + al, x_->m_type, x_->m_type->base.loc); ASR::expr_t* impl_cast_el_wise = ASRUtils::EXPR(ASR::make_Cast_t( al, loc, ref, x->m_kind, x_m_type, nullptr)); ASR::stmt_t* assign = ASRUtils::STMT(ASR::make_Assignment_t(al, loc, res, impl_cast_el_wise, nullptr)); @@ -991,8 +1111,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { *current_expr = result_var; if( op_expr == &(x->base) ) { op_dims = nullptr; - op_n_dims = ASRUtils::extract_dimensions_from_ttype( - ASRUtils::expr_type(*current_expr), op_dims); + op_n_dims = ASRUtils::extract_dimensions_from_ttype(x->m_type, op_dims); } result_var = nullptr; use_custom_loop_params = false; @@ -1060,7 +1179,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { loc, result_var_type, al, current_scope); result_counter += 1; if( allocate ) { - allocate_result_var(operand, operand_dims, rank_operand, true); + allocate_result_var(operand, operand_dims, rank_operand, true, true); } result_var_created = true; } @@ -1237,14 +1356,28 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { result_var = result_var_copy; bool result_var_created = false; if( result_var == nullptr ) { - result_var = PassUtils::create_var(result_counter, res_prefix, - loc, *current_expr, al, current_scope); + if (x->m_type && !ASRUtils::is_array(x->m_type)) { + ASR::ttype_t* sibling_type = ASRUtils::expr_type(operand); + ASR::dimension_t* m_dims; int ndims; + PassUtils::get_dim_rank(sibling_type, m_dims, ndims); + ASR::ttype_t* arr_type = ASRUtils::make_Array_t_util( + al, loc, x->m_type, m_dims, ndims); + if( ASRUtils::extract_physical_type(arr_type) == + ASR::array_physical_typeType::DescriptorArray ) { + arr_type = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, arr_type)); + } + result_var = PassUtils::create_var(result_counter, res_prefix, + loc, arr_type, al, current_scope); + } else { + result_var = PassUtils::create_var(result_counter, res_prefix, + loc, *current_expr, al, current_scope); + } result_counter += 1; operand = first_array_operand; ASR::dimension_t* m_dims; int n_dims = ASRUtils::extract_dimensions_from_ttype( ASRUtils::expr_type(first_array_operand), m_dims); - allocate_result_var(operand, m_dims, n_dims, true); + allocate_result_var(operand, m_dims, n_dims, true, false); result_var_created = true; } *current_expr = result_var; @@ -1287,15 +1420,18 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { result_var = nullptr; } - void replace_IntrinsicScalarFunction(ASR::IntrinsicScalarFunction_t* x) { - if(!ASRUtils::IntrinsicScalarFunctionRegistry::is_elemental(x->m_intrinsic_id)) { - return ; - } + void replace_IntrinsicElementalFunction(ASR::IntrinsicElementalFunction_t* x) { replace_intrinsic_function(x); } void replace_IntrinsicArrayFunction(ASR::IntrinsicArrayFunction_t* x) { if(!ASRUtils::IntrinsicArrayFunctionRegistry::is_elemental(x->m_arr_intrinsic_id)) { + // ASR::BaseExprReplacer::replace_IntrinsicArrayFunction(x); + if( op_expr == &(x->base) ) { + op_dims = nullptr; + op_n_dims = ASRUtils::extract_dimensions_from_ttype( + ASRUtils::expr_type(*current_expr), op_dims); + } return ; } replace_intrinsic_function(x); @@ -1346,6 +1482,10 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { int common_rank = 0; bool are_all_rank_same = true; for( size_t iarg = 0; iarg < x->n_args; iarg++ ) { + if (x->m_args[iarg].m_value == nullptr) { + operands.push_back(nullptr); + continue; + } ASR::expr_t** current_expr_copy_9 = current_expr; current_expr = &(x->m_args[iarg].m_value); self().replace_expr(x->m_args[iarg].m_value); @@ -1376,8 +1516,24 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { result_var = result_var_copy; bool result_var_created = false; if( result_var == nullptr ) { - result_var = PassUtils::create_var(result_counter, res_prefix, - loc, operand, al, current_scope); + ASR::Function_t* func = ASR::down_cast(ASRUtils::symbol_get_past_external(x->m_name)); + if (func->m_return_var != nullptr && !ASRUtils::is_array(ASRUtils::expr_type(func->m_return_var))) { + ASR::ttype_t* sibling_type = ASRUtils::expr_type(first_array_operand); + ASR::dimension_t* m_dims = nullptr; int ndims = 0; + PassUtils::get_dim_rank(sibling_type, m_dims, ndims); + LCOMPILERS_ASSERT(m_dims != nullptr); + ASR::ttype_t* arr_type = ASRUtils::make_Array_t_util( + al, loc, ASRUtils::expr_type(func->m_return_var), m_dims, ndims); + if( ASRUtils::extract_physical_type(arr_type) == + ASR::array_physical_typeType::DescriptorArray ) { + arr_type = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, arr_type)); + } + result_var = PassUtils::create_var(result_counter, res_prefix, + loc, arr_type, al, current_scope); + } else { + result_var = PassUtils::create_var(result_counter, res_prefix, + loc, operand, al, current_scope); + } result_counter += 1; result_var_created = true; } @@ -1390,7 +1546,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { ASR::dimension_t* m_dims; int n_dims = ASRUtils::extract_dimensions_from_ttype( ASRUtils::expr_type(operand), m_dims); - allocate_result_var(operand, m_dims, n_dims, result_var_created); + allocate_result_var(operand, m_dims, n_dims, result_var_created, false); *current_expr = result_var; Vec idx_vars, loop_vars, idx_vars_value; @@ -1407,7 +1563,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer { ref = PassUtils::create_array_ref(operands[iarg], idx_vars_value, al, current_scope); } ASR::call_arg_t ref_arg; - ref_arg.loc = ref->base.loc; + ref_arg.loc = x->m_args[iarg].loc; ref_arg.m_value = ref; ref_args.push_back(al, ref_arg); } @@ -1581,6 +1737,10 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor(*x.m_value) ) { + remove_original_statement = false; + return ; + } this->visit_expr(*x.m_value); } if (x.m_overloaded) { @@ -1589,14 +1749,25 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor(*ASRUtils::expr_type(x.m_target)) && - ASR::down_cast(ASRUtils::expr_type(x.m_target))->m_physical_type - == ASR::array_physical_typeType::SIMDArray) { - return; + const Location& loc = x.base.base.loc; + if (ASRUtils::is_simd_array(x.m_target)) { + size_t n_dims = 1; + if (ASR::is_a(*x.m_value)) { + n_dims = ASRUtils::extract_n_dims_from_ttype( + ASRUtils::expr_type(down_cast( + x.m_value)->m_v)); + } + if (n_dims == 1) { + if (!ASR::is_a(*x.m_value)) { + this->visit_expr(*x.m_value); + } + return; + } } if( (ASR::is_a(*ASRUtils::expr_type(x.m_target)) && ASR::is_a(*x.m_value)) || - (ASR::is_a(*x.m_value)) ) { + (ASR::is_a(*x.m_value) || + ASR::is_a(*x.m_value)) ) { if( realloc_lhs && ASRUtils::is_allocatable(x.m_target)) { // Add realloc-lhs later Vec vec_alloc; vec_alloc.reserve(al, 1); @@ -1612,11 +1783,14 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor vec_dims; vec_dims.reserve(al, n_dims); + ASR::ttype_t* int32_type = ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)); for( size_t i = 0; i < n_dims; i++ ) { ASR::dimension_t dim; dim.loc = x.m_value->base.loc; dim.m_start = PassUtils::get_bound(x.m_value, i + 1, "lbound", al); dim.m_length = ASRUtils::get_size(x.m_value, i + 1, al); + dim.m_start = CastingUtil::perform_casting(dim.m_start, int32_type, al, loc); + dim.m_length = CastingUtil::perform_casting(dim.m_length, int32_type, al, loc); vec_dims.push_back(al, dim); } @@ -1646,11 +1820,9 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor(*x.m_target) ) { ASR::ArraySection_t* array_ref = ASR::down_cast(x.m_target); replacer.result_var = array_ref->m_v; - remove_original_statement = true; result_lbound.reserve(al, array_ref->n_args); result_ubound.reserve(al, array_ref->n_args); result_inc.reserve(al, array_ref->n_args); @@ -1679,6 +1851,7 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor 0 ) { ASR::expr_t* idx_lb = PassUtils::get_bound(op_expr, 1, "lbound", al); @@ -1768,7 +1941,7 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitorbase.loc; ref_arg.m_value = array_item; ref_args.push_back(al, ref_arg); ASR::stmt_t* subroutine_call = ASRUtils::STMT(ASRUtils::make_SubroutineCall_t_util(al, x.base.base.loc, - x.m_name, x.m_original_name, ref_args.p, ref_args.n, nullptr, nullptr, false)); + x.m_name, x.m_original_name, ref_args.p, ref_args.n, nullptr, nullptr, false, ASRUtils::get_class_proc_nopass_val(x.m_name))); doloop_body.push_back(al, subroutine_call); }); remove_original_statement = true; diff --git a/src/libasr/pass/do_loops.cpp b/src/libasr/pass/do_loops.cpp index 0772908..cdc6cb8 100644 --- a/src/libasr/pass/do_loops.cpp +++ b/src/libasr/pass/do_loops.cpp @@ -43,6 +43,12 @@ class DoLoopVisitor : public ASR::StatementWalkVisitor void visit_DoLoop(const ASR::DoLoop_t &x) { pass_result = PassUtils::replace_doloop(al, x, -1, use_loop_variable_after_loop); } + + void visit_DoConcurrentLoop(const ASR::DoConcurrentLoop_t &x) { + ASR::asr_t* do_loop = ASR::make_DoLoop_t(al, x.base.base.loc, s2c(al, ""), x.m_head, x.m_body, x.n_body, nullptr, 0); + const ASR::DoLoop_t &do_loop_ref = (const ASR::DoLoop_t&)(*do_loop); + pass_result = PassUtils::replace_doloop(al, do_loop_ref, -1, use_loop_variable_after_loop); + } }; void pass_replace_do_loops(Allocator &al, ASR::TranslationUnit_t &unit, diff --git a/src/libasr/pass/function_call_in_declaration.cpp b/src/libasr/pass/function_call_in_declaration.cpp new file mode 100644 index 0000000..f94e237 --- /dev/null +++ b/src/libasr/pass/function_call_in_declaration.cpp @@ -0,0 +1,354 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +namespace LCompilers { + +using ASR::down_cast; +using ASR::is_a; + +/* + +This ASR pass replaces function calls in declarations with a new function call. +The function `pass_replace_function_call_in_declaration` transforms the ASR tree inplace. + +Converts: + +pure function diag_rsp_mat(A) result(res) +real, intent(in) :: A(:,:) +real :: res(minval(shape(A))) + +res = 123.71_4 +end function diag_rsp_mat + +To: + +pure integer function __lcompilers_created_helper_function_(A) result(r) +real, intent(in) :: A(:,:) +r = minval(shape(A)) +end function __lcompilers_created_helper_function_ + +pure function diag_rsp_mat(A) result(res) +real, intent(in) :: A(:,:) +real :: res(__lcompilers_created_helper_function_(A)) + +res = 123.71_4 +end function diag_rsp_mat + +*/ + +class ReplaceFunctionCall : public ASR::BaseExprReplacer +{ +public: + Allocator& al; + SymbolTable* current_scope = nullptr; + ASR::expr_t* assignment_value = nullptr; + ASR::expr_t* call_for_return_var = nullptr; + ASR::Function_t* current_function = nullptr; + Vec* newargsp = nullptr; + + struct ArgInfo { + int arg_number; + ASR::ttype_t* arg_type; + ASR::expr_t* arg_expr; + ASR::expr_t* arg_param; + }; + + ReplaceFunctionCall(Allocator &al_) : al(al_) {} + + void replace_FunctionParam(ASR::FunctionParam_t* x) { + if( newargsp == nullptr ) { + return ; + } + *current_expr = newargsp->p[x->m_param_number]; + } + + void replace_FunctionParam_with_FunctionArgs(ASR::expr_t*& value, Vec& new_args) { + if( !value ) { + return ; + } + newargsp = &new_args; + ASR::expr_t** current_expr_copy = current_expr; + current_expr = &value; + replace_expr(value); + current_expr = current_expr_copy; + newargsp = nullptr; + } + + bool exists_in_arginfo(int arg_number, std::vector& indicies) { + for (auto info: indicies) { + if (info.arg_number == arg_number) return true; + } + return false; + } + + void helper_get_arg_indices_used(ASR::expr_t* arg, std::vector& indicies) { + if (is_a(*arg)) { + ASR::ArrayPhysicalCast_t* cast = ASR::down_cast(arg); + arg = cast->m_arg; + } + if (is_a(*arg)) { + get_arg_indices_used_functioncall(ASR::down_cast(arg), indicies); + } else if (is_a(*arg)) { + get_arg_indices_used(ASR::down_cast(arg), indicies); + } else if (is_a(*arg)) { + ASR::FunctionParam_t* param = ASR::down_cast(arg); + ArgInfo info = {static_cast(param->m_param_number), param->m_type, current_function->m_args[param->m_param_number], arg}; + if (!exists_in_arginfo(param->m_param_number, indicies)) { + indicies.push_back(info); + } + } else if (is_a(*arg)) { + ASR::ArraySize_t* size = ASR::down_cast(arg); + helper_get_arg_indices_used(size->m_v, indicies); + } else if (is_a(*arg)) { + ASR::IntegerCompare_t* comp = ASR::down_cast(arg); + helper_get_arg_indices_used(comp->m_left, indicies); + helper_get_arg_indices_used(comp->m_right, indicies); + } + } + + void get_arg_indices_used_functioncall(ASR::FunctionCall_t* x, std::vector& indicies) { + for (size_t i = 0; i < x->n_args; i++) { + ASR::expr_t* arg = x->m_args[i].m_value; + helper_get_arg_indices_used(arg, indicies); + } + return; + } + + template + void get_arg_indices_used(T* x, std::vector& indicies) { + for (size_t i = 0; i < x->n_args; i++) { + ASR::expr_t* arg = x->m_args[i]; + helper_get_arg_indices_used(arg, indicies); + } + return; + } + + void replace_IntrinsicArrayFunction(ASR::IntrinsicArrayFunction_t *x) { + if (!current_scope || !current_function || !assignment_value) return; + + if( newargsp != nullptr ) { + BaseExprReplacer::replace_IntrinsicArrayFunction(x); + return ; + } + + std::vector indicies; + get_arg_indices_used(x, indicies); + + SymbolTable* global_scope = current_scope; + while (global_scope->parent) { + global_scope = global_scope->parent; + } + SetChar current_function_dependencies; current_function_dependencies.clear(al); + SymbolTable* new_scope = al.make_new(global_scope); + + ASRUtils::SymbolDuplicator sd(al); + ASRUtils::ASRBuilder b(al, x->base.base.loc); + Vec new_args; new_args.reserve(al, indicies.size()); + Vec new_call_args; new_call_args.reserve(al, indicies.size()); + Vec args_for_return_var; args_for_return_var.reserve(al, indicies.size()); + + Vec new_body; new_body.reserve(al, 1); + std::string new_function_name = global_scope->get_unique_name("__lcompilers_created_helper_function_", false); + ASR::ttype_t* integer_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x->base.base.loc, 4)); + ASR::expr_t* return_var = b.Variable(new_scope, new_scope->get_unique_name("__lcompilers_return_var_", false), integer_type, ASR::intentType::ReturnVar); + + for (auto arg: indicies) { + ASR::expr_t* arg_expr = arg.arg_expr; + if (is_a(*arg_expr)) { + ASR::Var_t* var = ASR::down_cast(arg_expr); + sd.duplicate_symbol(var->m_v, new_scope); + ASR::expr_t* new_var_expr = ASRUtils::EXPR(ASR::make_Var_t(al, var->base.base.loc, new_scope->get_symbol(ASRUtils::symbol_name(var->m_v)))); + new_args.push_back(al, new_var_expr); + } + ASR::call_arg_t new_call_arg; new_call_arg.loc = arg_expr->base.loc; new_call_arg.m_value = arg.arg_param; + new_call_args.push_back(al, new_call_arg); + + ASR::call_arg_t arg_for_return_var; arg_for_return_var.loc = arg_expr->base.loc; arg_for_return_var.m_value = arg.arg_expr; + args_for_return_var.push_back(al, arg_for_return_var); + } + replace_FunctionParam_with_FunctionArgs(assignment_value, new_args); + new_body.push_back(al, b.Assignment(return_var, assignment_value)); + ASR::asr_t* new_function = ASRUtils::make_Function_t_util(al, current_function->base.base.loc, + new_scope, s2c(al, new_function_name), current_function_dependencies.p, current_function_dependencies.n, + new_args.p, new_args.n, + new_body.p, new_body.n, + return_var, + ASR::abiType::Source, ASR::accessType::Public, ASR::deftypeType::Implementation, + nullptr, false, false, false, false, false, nullptr, 0, + false, false, false); + + ASR::symbol_t* new_function_sym = ASR::down_cast(new_function); + global_scope->add_or_overwrite_symbol(new_function_name, new_function_sym); + + ASR::expr_t* new_function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x->base.base.loc, + new_function_sym, + new_function_sym, + new_call_args.p, new_call_args.n, + integer_type, + nullptr, + nullptr)); + *current_expr = new_function_call; + + ASR::expr_t* function_call_for_return_var = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x->base.base.loc, + new_function_sym, + new_function_sym, + args_for_return_var.p, args_for_return_var.n, + integer_type, + nullptr, + nullptr)); + call_for_return_var = function_call_for_return_var; + } + +}; + +class FunctionTypeVisitor : public ASR::CallReplacerOnExpressionsVisitor +{ +public: + + Allocator &al; + ReplaceFunctionCall replacer; + SymbolTable* current_scope; + Vec pass_result; + + + FunctionTypeVisitor(Allocator &al_) : al(al_), replacer(al_) { + current_scope = nullptr; + pass_result.reserve(al, 1); + } + + void call_replacer_(ASR::expr_t* value) { + replacer.current_expr = current_expr; + replacer.current_scope = current_scope; + replacer.assignment_value = value; + ASR::asr_t* asr_owner = current_scope->asr_owner; + if (asr_owner) { + ASR::Function_t* func = ASR::down_cast2(asr_owner); + replacer.current_function = func; + } + replacer.replace_expr(*current_expr); + replacer.current_scope = nullptr; + replacer.current_function = nullptr; + replacer.assignment_value = nullptr; + } + + bool is_function_call_or_intrinsic_array_function(ASR::expr_t* expr) { + if (!expr) return false; + if (is_a(*expr)) { + return true; + } else if (is_a(*expr)) { + return true; + } + return false; + } + + void set_type_of_result_var(const ASR::FunctionType_t &x, ASR::Function_t* func) { + if( !ASR::is_a(*x.m_return_var_type) ) { + return ; + } + ASR::ttype_t* return_type_copy = ASRUtils::duplicate_type(al, x.m_return_var_type); + ASR::Array_t* array_t = ASR::down_cast(return_type_copy); + Vec new_args; new_args.reserve(al, func->n_args); + for (size_t j = 0; j < func->n_args; j++) { + new_args.push_back(al, func->m_args[j]); + } + for( size_t i = 0; i < array_t->n_dims; i++ ) { + replacer.replace_FunctionParam_with_FunctionArgs(array_t->m_dims[i].m_start, new_args); + replacer.replace_FunctionParam_with_FunctionArgs(array_t->m_dims[i].m_length, new_args); + } + ASRUtils::EXPR2VAR(func->m_return_var)->m_type = return_type_copy; + } + + void visit_FunctionType(const ASR::FunctionType_t &x) { + if (!current_scope) return; + + ASR::ttype_t* return_var_type = x.m_return_var_type; + + if (return_var_type && ASRUtils::is_array(return_var_type)) { + ASR::Function_t* func = nullptr; + ASR::asr_t* asr_owner = current_scope->asr_owner; + if (ASR::is_a(*asr_owner)) { + ASR::symbol_t* sym = ASR::down_cast(asr_owner); + if (ASR::is_a(*sym)) { + func = ASR::down_cast2(current_scope->asr_owner); + } + } + if (!func) return; + ASR::Array_t* arr = ASR::down_cast(ASRUtils::type_get_past_allocatable(ASRUtils::type_get_past_pointer(return_var_type))); + for (size_t i = 0; i < arr->n_dims; i++) { + ASR::dimension_t dim = arr->m_dims[i]; + ASR::expr_t* start = dim.m_start; + ASR::expr_t* end = dim.m_length; + if (start && is_a(*start)) { + ASR::IntegerBinOp_t* binop = ASR::down_cast(start); + if (is_function_call_or_intrinsic_array_function(binop->m_left)) { + ASR::expr_t** current_expr_copy = current_expr; + current_expr = const_cast(&(binop->m_left)); + this->call_replacer_(binop->m_left); + current_expr = current_expr_copy; + } + if (is_function_call_or_intrinsic_array_function(binop->m_right)) { + ASR::expr_t** current_expr_copy = current_expr; + current_expr = const_cast(&(binop->m_right)); + this->call_replacer_(binop->m_right); + current_expr = current_expr_copy; + } + + } + if (end && is_a(*end)) { + ASR::IntegerBinOp_t* binop = ASR::down_cast(end); + if (is_function_call_or_intrinsic_array_function(binop->m_left)) { + ASR::expr_t** current_expr_copy = current_expr; + current_expr = const_cast(&(binop->m_left)); + this->call_replacer_(binop->m_left); + current_expr = current_expr_copy; + } + if (is_function_call_or_intrinsic_array_function(binop->m_right)) { + ASR::expr_t** current_expr_copy = current_expr; + current_expr = const_cast(&(binop->m_right)); + this->call_replacer_(binop->m_right); + current_expr = current_expr_copy; + } + + } + if (is_function_call_or_intrinsic_array_function(start)) { + ASR::expr_t** current_expr_copy = current_expr; + current_expr = const_cast(&(ASR::down_cast(x.m_return_var_type)->m_dims[i].m_start)); + this->call_replacer_(start); + current_expr = current_expr_copy; + } + if (is_function_call_or_intrinsic_array_function(end)) { + ASR::expr_t** current_expr_copy = current_expr; + current_expr = const_cast(&(ASR::down_cast(x.m_return_var_type)->m_dims[i].m_length)); + this->call_replacer_(end); + current_expr = current_expr_copy; + } + } + + set_type_of_result_var(x, func); + } + } + + void visit_Function(const ASR::Function_t &x) { + current_scope = x.m_symtab; + this->visit_ttype(*x.m_function_signature); + current_scope = nullptr; + } + +}; + +void pass_replace_function_call_in_declaration(Allocator &al, ASR::TranslationUnit_t &unit, + const LCompilers::PassOptions& /*pass_options*/) { + FunctionTypeVisitor v(al); + v.visit_TranslationUnit(unit); + PassUtils::UpdateDependenciesVisitor x(al); + x.visit_TranslationUnit(unit); +} + + +} // namespace LCompilers diff --git a/src/libasr/pass/implied_do_loops.cpp b/src/libasr/pass/implied_do_loops.cpp index c4254dc..f490105 100644 --- a/src/libasr/pass/implied_do_loops.cpp +++ b/src/libasr/pass/implied_do_loops.cpp @@ -46,14 +46,15 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { ASR::expr_t* end = implied_doloop->m_end; ASR::expr_t* d = implied_doloop->m_increment; ASR::expr_t* implied_doloop_size = nullptr; + int kind = ASRUtils::extract_kind_from_ttype_t(ASRUtils::expr_type(end)); if( d == nullptr ) { implied_doloop_size = builder.ElementalAdd( builder.ElementalSub(end, start, loc), - make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, 1, 4, loc), loc); + make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, 1, kind, loc), loc); } else { implied_doloop_size = builder.ElementalAdd(builder.ElementalDiv( builder.ElementalSub(end, start, loc), d, loc), - make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, 1, 4, loc), loc); + make_ConstantWithKind(make_IntegerConstant_t, make_Integer_t, 1, kind, loc), loc); } int const_elements = 0; ASR::expr_t* implied_doloop_size_ = nullptr; @@ -74,11 +75,11 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { if( const_elements > 1 ) { if( implied_doloop_size_ == nullptr ) { implied_doloop_size_ = make_ConstantWithKind(make_IntegerConstant_t, - make_Integer_t, const_elements, 4, loc); + make_Integer_t, const_elements, kind, loc); } else { implied_doloop_size_ = builder.ElementalAdd( make_ConstantWithKind(make_IntegerConstant_t, - make_Integer_t, const_elements, 4, loc), + make_Integer_t, const_elements, kind, loc), implied_doloop_size_, loc); } } @@ -89,19 +90,10 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { } size_t get_constant_ArrayConstant_size(ASR::ArrayConstant_t* x) { - size_t size = 0; - for( size_t i = 0; i < x->n_args; i++ ) { - if( ASR::is_a(*x->m_args[i]) ) { - size += get_constant_ArrayConstant_size( - ASR::down_cast(x->m_args[i])); - } else { - size += 1; - } - } - return size; + return x->n_args; } - ASR::expr_t* get_ArrayConstant_size(ASR::ArrayConstant_t* x, bool& is_allocatable) { + ASR::expr_t* get_ArrayConstructor_size(ASR::ArrayConstructor_t* x, bool& is_allocatable) { ASR::ttype_t* int_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x->base.base.loc, 4)); ASR::expr_t* array_size = nullptr; int64_t constant_size = 0; @@ -115,7 +107,7 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { ASR::down_cast(element)); } else { ASR::expr_t* element_array_size = get_ArrayConstant_size( - ASR::down_cast(element), is_allocatable); + ASR::down_cast(element)); if( array_size == nullptr ) { array_size = element_array_size; } else { @@ -123,6 +115,15 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { element_array_size, x->base.base.loc); } } + } else if( ASR::is_a(*element) ) { + ASR::expr_t* element_array_size = get_ArrayConstructor_size( + ASR::down_cast(element), is_allocatable); + if( array_size == nullptr ) { + array_size = element_array_size; + } else { + array_size = builder.ElementalAdd(array_size, + element_array_size, x->base.base.loc); + } } else if( ASR::is_a(*element) ) { ASR::ttype_t* element_type = ASRUtils::type_get_past_allocatable( ASRUtils::expr_type(element)); @@ -201,6 +202,98 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { return array_size; } + ASR::expr_t* get_ArrayConstant_size(ASR::ArrayConstant_t* x) { + ASR::ttype_t* int_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x->base.base.loc, 4)); + return make_ConstantWithType(make_IntegerConstant_t, + ASRUtils::get_fixed_size_of_array(x->m_type), int_type, x->base.base.loc); + } + + void replace_ArrayConstructor(ASR::ArrayConstructor_t* x) { + const Location& loc = x->base.base.loc; + ASR::expr_t* result_var_copy = result_var; + bool is_result_var_fixed_size = false; + if (result_var != nullptr && + resultvar2value.find(result_var) != resultvar2value.end() && + resultvar2value[result_var] == &(x->base)) { + is_result_var_fixed_size = ASRUtils::is_fixed_size_array(ASRUtils::expr_type(result_var)); + } + ASR::ttype_t* result_type_ = nullptr; + bool is_allocatable = false; + ASR::expr_t* array_constructor = get_ArrayConstructor_size(x, is_allocatable); + Vec dims; + dims.reserve(al, 1); + ASR::dimension_t dim; + dim.loc = loc; + dim.m_start = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 1, + ASRUtils::type_get_past_pointer( + ASRUtils::type_get_past_allocatable( + ASRUtils::expr_type(array_constructor))))); + dim.m_length = array_constructor; + dims.push_back(al, dim); + remove_original_statement = false; + if( is_result_var_fixed_size ) { + result_type_ = ASRUtils::expr_type(result_var); + is_allocatable = false; + } else { + if( is_allocatable ) { + result_type_ = ASRUtils::TYPE(ASR::make_Allocatable_t(al, x->m_type->base.loc, + ASRUtils::type_get_past_allocatable( + ASRUtils::duplicate_type_with_empty_dims(al, x->m_type)))); + } else { + result_type_ = ASRUtils::duplicate_type(al, + ASRUtils::type_get_past_allocatable(x->m_type), &dims); + } + } + result_var = PassUtils::create_var(result_counter, "_array_constructor_", + loc, result_type_, al, current_scope); + result_counter += 1; + *current_expr = result_var; + + Vec alloc_args; + alloc_args.reserve(al, 1); + ASR::alloc_arg_t arg; + arg.m_len_expr = nullptr; + arg.m_type = nullptr; + arg.m_dims = dims.p; + arg.n_dims = dims.size(); + if( is_allocatable ) { + arg.loc = result_var->base.loc; + arg.m_a = result_var; + alloc_args.push_back(al, arg); + Vec to_be_deallocated; + to_be_deallocated.reserve(al, alloc_args.size()); + for( size_t i = 0; i < alloc_args.size(); i++ ) { + to_be_deallocated.push_back(al, alloc_args.p[i].m_a); + } + pass_result.push_back(al, ASRUtils::STMT(ASR::make_ExplicitDeallocate_t( + al, loc, to_be_deallocated.p, to_be_deallocated.size()))); + ASR::stmt_t* allocate_stmt = ASRUtils::STMT(ASR::make_Allocate_t( + al, loc, alloc_args.p, alloc_args.size(), nullptr, nullptr, nullptr)); + pass_result.push_back(al, allocate_stmt); + } + if ( allocate_target && realloc_lhs ) { + allocate_target = false; + arg.loc = result_var_copy->base.loc; + arg.m_a = result_var_copy; + alloc_args.push_back(al, arg); + Vec to_be_deallocated; + to_be_deallocated.reserve(al, alloc_args.size()); + for( size_t i = 0; i < alloc_args.size(); i++ ) { + to_be_deallocated.push_back(al, alloc_args.p[i].m_a); + } + pass_result.push_back(al, ASRUtils::STMT(ASR::make_ExplicitDeallocate_t( + al, loc, to_be_deallocated.p, to_be_deallocated.size()))); + ASR::stmt_t* allocate_stmt = ASRUtils::STMT(ASR::make_Allocate_t( + al, loc, alloc_args.p, alloc_args.size(), nullptr, nullptr, nullptr)); + pass_result.push_back(al, allocate_stmt); + } + LCOMPILERS_ASSERT(result_var != nullptr); + Vec* result_vec = &pass_result; + PassUtils::ReplacerUtils::replace_ArrayConstructor(x, this, + remove_original_statement, result_vec); + result_var = result_var_copy; + } + void replace_ArrayConstant(ASR::ArrayConstant_t* x) { const Location& loc = x->base.base.loc; ASR::expr_t* result_var_copy = result_var; @@ -212,7 +305,7 @@ class ReplaceArrayConstant: public ASR::BaseExprReplacer { } ASR::ttype_t* result_type_ = nullptr; bool is_allocatable = false; - ASR::expr_t* array_constant_size = get_ArrayConstant_size(x, is_allocatable); + ASR::expr_t* array_constant_size = get_ArrayConstant_size(x); Vec dims; dims.reserve(al, 1); ASR::dimension_t dim; @@ -427,7 +520,7 @@ class ArrayConstantVisitor : public ASR::CallReplacerOnExpressionsVisitorbase.loc, ASRUtils::expr_type(value), dim.p, dim.size(), ASR::array_physical_typeType::FixedSizeArray)); - ASR::asr_t* array_constant = ASR::make_ArrayConstant_t(al, value->base.loc, + ASR::asr_t* array_constant = ASRUtils::make_ArrayConstructor_t_util(al, value->base.loc, args.p, args.n, array_type, ASR::arraystorageType::ColMajor); return array_constant; } @@ -508,7 +601,21 @@ class ArrayConstantVisitor : public ASR::CallReplacerOnExpressionsVisitorvisit_stmt(*x.m_overloaded); + remove_original_statement = false; + return; + } + } + void visit_FileWrite(const ASR::FileWrite_t &x) { + if (x.m_overloaded) { + this->visit_stmt(*x.m_overloaded); + remove_original_statement = false; + return; + } + /* integer :: i write(*,*) (i, i=1, 10) diff --git a/src/libasr/pass/init_expr.cpp b/src/libasr/pass/init_expr.cpp index bab7f2f..0ee4c67 100644 --- a/src/libasr/pass/init_expr.cpp +++ b/src/libasr/pass/init_expr.cpp @@ -52,6 +52,23 @@ class ReplaceInitExpr: public ASR::BaseExprReplacer { *current_expr = nullptr; } + void replace_ArrayConstructor(ASR::ArrayConstructor_t* x) { + if( symtab2decls.find(current_scope) == symtab2decls.end() ) { + Vec result_vec_; + result_vec_.reserve(al, 0); + symtab2decls[current_scope] = result_vec_; + } + Vec* result_vec = &symtab2decls[current_scope]; + bool remove_original_statement = false; + if( casted_type != nullptr ) { + casted_type = ASRUtils::type_get_past_array(casted_type); + } + PassUtils::ReplacerUtils::replace_ArrayConstructor(x, this, + remove_original_statement, result_vec, + perform_cast, cast_kind, casted_type); + *current_expr = nullptr; + } + void replace_StructTypeConstructor(ASR::StructTypeConstructor_t* x) { if( symtab2decls.find(current_scope) == symtab2decls.end() ) { Vec result_vec_; @@ -165,9 +182,11 @@ class InitExprVisitor : public ASR::CallReplacerOnExpressionsVisitor(*symbolic_value) || - ASR::is_a(*symbolic_value))) || + ASR::is_a(*symbolic_value) || + ASR::is_a(*symbolic_value))) || (ASR::is_a(*asr_owner) && - ASR::is_a(*symbolic_value))) { + (ASR::is_a(*symbolic_value) || + ASR::is_a(*symbolic_value)))) { return ; } diff --git a/src/libasr/pass/instantiate_template.cpp b/src/libasr/pass/instantiate_template.cpp index 65b8145..aa3576c 100644 --- a/src/libasr/pass/instantiate_template.cpp +++ b/src/libasr/pass/instantiate_template.cpp @@ -7,6 +7,8 @@ namespace LCompilers { +namespace LPython { + class SymbolRenamer : public ASR::BaseExprStmtDuplicator { public: @@ -47,7 +49,7 @@ class SymbolRenamer : public ASR::BaseExprStmtDuplicator ASR::ttype_t *t = x->m_type; ASR::dimension_t* tp_m_dims = nullptr; int tp_n_dims = ASRUtils::extract_dimensions_from_ttype(t, tp_m_dims); - + if (ASR::is_a(*t)) { ASR::TypeParameter_t *tp = ASR::down_cast(t); if (type_subs.find(tp->m_param) != type_subs.end()) { @@ -98,7 +100,7 @@ class SymbolRenamer : public ASR::BaseExprStmtDuplicator ASR::symbol_t *new_f = ASR::down_cast(ASRUtils::make_Function_t_util( al, x->base.base.loc, current_scope, s2c(al, new_sym_name), x->m_dependencies, - x->n_dependencies, args.p, args.size(), nullptr, 0, new_return_var_ref, ftype->m_abi, + x->n_dependencies, args.p, args.size(), nullptr, 0, new_return_var_ref, ftype->m_abi, x->m_access, ftype->m_deftype, ftype->m_bindc_name, ftype->m_elemental, ftype->m_pure, ftype->m_module, ftype->m_inline, ftype->m_static, ftype->m_restrictions, ftype->n_restrictions, ftype->m_is_restriction, x->m_deterministic, x->m_side_effect_free)); @@ -434,7 +436,7 @@ class SymbolInstantiator : public ASR::BaseExprStmtDuplicator(ASR::make_ClassProcedure_t( al, x->base.base.loc, current_scope, x->m_name, x->m_self_argument, - s2c(al, new_cp_name), new_cp_proc, x->m_abi, x->m_is_deferred)); + s2c(al, new_cp_name), new_cp_proc, x->m_abi, x->m_is_deferred, x->m_is_nopass)); current_scope->add_symbol(x->m_name, new_x); return new_x; @@ -473,6 +475,16 @@ class SymbolInstantiator : public ASR::BaseExprStmtDuplicatorbase.base.loc, m_args.p, x->n_args, m_type, x->m_storage_format); } + ASR::asr_t* duplicate_ArrayConstructor(ASR::ArrayConstructor_t *x) { + Vec m_args; + m_args.reserve(al, x->n_args); + for (size_t i = 0; i < x->n_args; i++) { + m_args.push_back(al, self().duplicate_expr(x->m_args[i])); + } + ASR::ttype_t* m_type = substitute_type(x->m_type); + return make_ArrayConstructor_t(al, x->base.base.loc, m_args.p, x->n_args, m_type, x->m_value, x->m_storage_format); + } + ASR::asr_t* duplicate_ListItem(ASR::ListItem_t *x) { ASR::expr_t *m_a = duplicate_expr(x->m_a); ASR::expr_t *m_pos = duplicate_expr(x->m_pos); @@ -513,7 +525,7 @@ class SymbolInstantiator : public ASR::BaseExprStmtDuplicatorm_head.m_end); head.m_increment = duplicate_expr(x->m_head.m_increment); head.loc = x->m_head.m_v->base.loc; - return ASR::make_DoLoop_t(al, x->base.base.loc, x->m_name, head, m_body.p, x->n_body); + return ASR::make_DoLoop_t(al, x->base.base.loc, x->m_name, head, m_body.p, x->n_body, nullptr, 0); } ASR::asr_t* duplicate_Cast(ASR::Cast_t *x) { @@ -612,7 +624,7 @@ class SymbolInstantiator : public ASR::BaseExprStmtDuplicatorbase.base.loc, name /* change this */, - x->m_original_name, args.p, args.size(), dt, nullptr, false); + x->m_original_name, args.p, args.size(), dt, nullptr, false, false); } ASR::asr_t* duplicate_StructInstanceMember(ASR::StructInstanceMember_t *x) { @@ -887,4 +899,1057 @@ void report_check_restriction(std::map type_subs, symbol_subs[f_name] = sym_arg; } +} // namespace LPython + +namespace LFortran { + +class SymbolRenamer : public ASR::BaseExprStmtDuplicator +{ +public: + SymbolTable* current_scope; + std::map &type_subs; + std::string new_sym_name; + + SymbolRenamer(Allocator& al, std::map& type_subs, + SymbolTable* current_scope, std::string new_sym_name): + BaseExprStmtDuplicator(al), + current_scope{current_scope}, + type_subs{type_subs}, + new_sym_name{new_sym_name} + {} + + ASR::symbol_t* rename_symbol(ASR::symbol_t *x) { + switch (x->type) { + case (ASR::symbolType::Variable): { + ASR::Variable_t *v = ASR::down_cast(x); + return rename_Variable(v); + } + case (ASR::symbolType::Function): { + if (current_scope->get_symbol(new_sym_name)) { + return current_scope->get_symbol(new_sym_name); + } + ASR::Function_t *f = ASR::down_cast(x); + return rename_Function(f); + } + default: { + std::string sym_name = ASRUtils::symbol_name(x); + throw new LCompilersException("Symbol renaming not supported " + " for " + sym_name); + } + } + } + + ASR::symbol_t* rename_Variable(ASR::Variable_t *x) { + ASR::ttype_t *t = x->m_type; + ASR::dimension_t* tp_m_dims = nullptr; + int tp_n_dims = ASRUtils::extract_dimensions_from_ttype(t, tp_m_dims); + + if (ASR::is_a(*t)) { + ASR::TypeParameter_t *tp = ASR::down_cast(t); + if (type_subs.find(tp->m_param) != type_subs.end()) { + t = ASRUtils::make_Array_t_util(al, tp->base.base.loc, + ASRUtils::duplicate_type(al, type_subs[tp->m_param]), + tp_m_dims, tp_n_dims); + } else { + t = ASRUtils::make_Array_t_util(al, tp->base.base.loc, ASRUtils::TYPE( + ASR::make_TypeParameter_t(al, tp->base.base.loc, + s2c(al, new_sym_name))), tp_m_dims, tp_n_dims); + type_subs[tp->m_param] = t; + } + } + + if (current_scope->get_symbol(new_sym_name)) { + return current_scope->get_symbol(new_sym_name); + } + + ASR::symbol_t* new_v = ASR::down_cast(ASR::make_Variable_t( + al, x->base.base.loc, + current_scope, s2c(al, new_sym_name), x->m_dependencies, + x->n_dependencies, x->m_intent, x->m_symbolic_value, + x->m_value, x->m_storage, t, x->m_type_declaration, + x->m_abi, x->m_access, x->m_presence, x->m_value_attr)); + + current_scope->add_symbol(new_sym_name, new_v); + + return new_v; + } + + ASR::symbol_t* rename_Function(ASR::Function_t *x) { + ASR::FunctionType_t* ftype = ASR::down_cast(x->m_function_signature); + + SymbolTable* parent_scope = current_scope; + current_scope = al.make_new(parent_scope); + + Vec args; + args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + ASR::expr_t *new_arg = duplicate_expr(x->m_args[i]); + args.push_back(al, new_arg); + } + + ASR::expr_t *new_return_var_ref = nullptr; + if (x->m_return_var != nullptr) { + new_return_var_ref = duplicate_expr(x->m_return_var); + } + + ASR::symbol_t *new_f = ASR::down_cast(ASRUtils::make_Function_t_util( + al, x->base.base.loc, current_scope, s2c(al, new_sym_name), x->m_dependencies, + x->n_dependencies, args.p, args.size(), nullptr, 0, new_return_var_ref, ftype->m_abi, + x->m_access, ftype->m_deftype, ftype->m_bindc_name, ftype->m_elemental, + ftype->m_pure, ftype->m_module, ftype->m_inline, ftype->m_static, ftype->m_restrictions, + ftype->n_restrictions, ftype->m_is_restriction, x->m_deterministic, x->m_side_effect_free)); + + parent_scope->add_symbol(new_sym_name, new_f); + current_scope = parent_scope; + + return new_f; + } + + ASR::asr_t* duplicate_Var(ASR::Var_t *x) { + std::string sym_name = ASRUtils::symbol_name(x->m_v); + ASR::symbol_t* sym = duplicate_symbol(x->m_v); + return ASR::make_Var_t(al, x->base.base.loc, sym); + } + + ASR::symbol_t* duplicate_symbol(ASR::symbol_t *x) { + ASR::symbol_t* new_symbol = nullptr; + switch (x->type) { + case ASR::symbolType::Variable: { + new_symbol = duplicate_Variable(ASR::down_cast(x)); + break; + } + default: { + throw LCompilersException("Unsupported symbol for symbol renaming"); + } + } + return new_symbol; + } + + ASR::symbol_t* duplicate_Variable(ASR::Variable_t *x) { + ASR::symbol_t *v = current_scope->get_symbol(x->m_name); + if (!v) { + ASR::ttype_t *t = substitute_type(x->m_type); + v = ASR::down_cast(ASR::make_Variable_t( + al, x->base.base.loc, current_scope, x->m_name, x->m_dependencies, + x->n_dependencies, x->m_intent, x->m_symbolic_value, + x->m_value, x->m_storage, t, x->m_type_declaration, + x->m_abi, x->m_access, x->m_presence, x->m_value_attr)); + current_scope->add_symbol(x->m_name, v); + } + return v; + } + + ASR::ttype_t* substitute_type(ASR::ttype_t *ttype) { + switch (ttype->type) { + case (ASR::ttypeType::TypeParameter) : { + ASR::TypeParameter_t *tp = ASR::down_cast(ttype); + LCOMPILERS_ASSERT(type_subs.find(tp->m_param) != type_subs.end()); + return ASRUtils::duplicate_type(al, type_subs[tp->m_param]); + } + case (ASR::ttypeType::Array) : { + ASR::Array_t *a = ASR::down_cast(ttype); + ASR::ttype_t *t = substitute_type(a->m_type); + ASR::dimension_t* m_dims = nullptr; + size_t n_dims = ASRUtils::extract_dimensions_from_ttype(ttype, m_dims); + Vec new_dims; + new_dims.reserve(al, n_dims); + for (size_t i = 0; i < n_dims; i++) { + ASR::dimension_t old_dim = m_dims[i]; + ASR::dimension_t new_dim; + new_dim.loc = old_dim.loc; + new_dim.m_start = duplicate_expr(old_dim.m_start); + new_dim.m_length = duplicate_expr(old_dim.m_length); + new_dims.push_back(al, new_dim); + } + return ASRUtils::make_Array_t_util(al, t->base.loc, + t, new_dims.p, new_dims.size()); + } + default : return ttype; + } + } + +}; + +class SymbolInstantiator : public ASR::BaseExprStmtDuplicator +{ +public: + SymbolTable* target_scope; // scope where the instantiation is + SymbolTable* new_scope; // scope of the new symbol + std::map type_subs; // type name -> ASR type map based on instantiation's args + std::map& symbol_subs; // symbol name -> ASR symbol map based on instantiation's args + std::string new_sym_name; // name for the new symbol + ASR::symbol_t* sym; + SetChar dependencies; + + SymbolInstantiator(Allocator &al, + SymbolTable* target_scope, + std::map type_subs, + std::map& symbol_subs, + std::string new_sym_name, ASR::symbol_t* sym): + BaseExprStmtDuplicator(al), + target_scope{target_scope}, + new_scope{target_scope}, + type_subs{type_subs}, + symbol_subs{symbol_subs}, + new_sym_name{new_sym_name}, sym{sym} + {} + + ASR::symbol_t* instantiate() { + std::string sym_name = ASRUtils::symbol_name(sym); + + // if passed as instantiation's argument + if (symbol_subs.find(sym_name) != symbol_subs.end()) { + ASR::symbol_t* added_sym = symbol_subs[sym_name]; + std::string added_sym_name = ASRUtils::symbol_name(added_sym); + if (new_scope->resolve_symbol(added_sym_name)) { + return new_scope->resolve_symbol(added_sym_name); + } + } + + // check current scope + if (target_scope->get_symbol(sym_name) != nullptr) { + return target_scope->get_symbol(sym_name); + } + + switch (sym->type) { + case (ASR::symbolType::Function) : { + ASR::Function_t* x = ASR::down_cast(sym); + return instantiate_Function(x); + } + case (ASR::symbolType::Variable) : { + ASR::Variable_t* x = ASR::down_cast(sym); + return instantiate_Variable(x); + } + case (ASR::symbolType::Template) : { + ASR::Template_t* x = ASR::down_cast(sym); + return instantiate_Template(x); + } + case (ASR::symbolType::StructType) : { + ASR::StructType_t* x = ASR::down_cast(sym); + return instantiate_StructType(x); + } + case (ASR::symbolType::ExternalSymbol) : { + ASR::ExternalSymbol_t* x = ASR::down_cast(sym); + return instantiate_ExternalSymbol(x); + } + case (ASR::symbolType::ClassProcedure) : { + ASR::ClassProcedure_t* x = ASR::down_cast(sym); + return instantiate_ClassProcedure(x); + } + case (ASR::symbolType::CustomOperator) : { + ASR::CustomOperator_t* x = ASR::down_cast(sym); + return instantiate_CustomOperator(x); + } + default: { + std::string sym_name = ASRUtils::symbol_name(sym); + throw LCompilersException("Instantiation of " + sym_name + + " symbol is not supported"); + }; + } + } + + ASR::symbol_t* instantiate_Function(ASR::Function_t* x) { + dependencies.clear(al); + new_scope = al.make_new(target_scope); + + // duplicate symbol table + for (auto const &sym_pair: x->m_symtab->get_scope()) { + SymbolInstantiator t(al, new_scope, type_subs, symbol_subs, + ASRUtils::symbol_name(sym_pair.second), sym_pair.second); + t.instantiate(); + } + + Vec args; + args.reserve(al, x->n_args); + ASR::expr_t *new_return_var_ref = nullptr; + SetChar deps_vec; + deps_vec.reserve(al, dependencies.size()); + + for (size_t i=0; in_args; i++) { + ASR::expr_t *new_arg = duplicate_expr(x->m_args[i]); + args.push_back(al, new_arg); + } + + if (x->m_return_var != nullptr) { + new_return_var_ref = duplicate_expr(x->m_return_var); + } + + for( size_t i = 0; i < dependencies.size(); i++ ) { + char* dep = dependencies[i]; + deps_vec.push_back(al, dep); + } + + ASR::asr_t *result = ASRUtils::make_Function_t_util( + al, x->base.base.loc, new_scope, s2c(al, new_sym_name), + deps_vec.p, deps_vec.size(), args.p, args.size(), + nullptr, 0, new_return_var_ref, + ASRUtils::get_FunctionType(x)->m_abi, x->m_access, + ASRUtils::get_FunctionType(x)->m_deftype, ASRUtils::get_FunctionType(x)->m_bindc_name, + ASRUtils::get_FunctionType(x)->m_elemental, ASRUtils::get_FunctionType(x)->m_pure, + ASRUtils::get_FunctionType(x)->m_module, ASRUtils::get_FunctionType(x)->m_inline, + ASRUtils::get_FunctionType(x)->m_static, ASRUtils::get_FunctionType(x)->m_restrictions, + ASRUtils::get_FunctionType(x)->n_restrictions, false, false, false); + + ASR::symbol_t *f = ASR::down_cast(result); + target_scope->add_symbol(new_sym_name, f); + symbol_subs[x->m_name] = f; + + return f; + } + + ASR::symbol_t* instantiate_Variable(ASR::Variable_t* x) { + ASR::ttype_t *new_type = substitute_type(x->m_type); + + SetChar variable_dependencies_vec; + variable_dependencies_vec.reserve(al, 1); + ASRUtils::collect_variable_dependencies(al, variable_dependencies_vec, new_type); + + ASR::symbol_t* s = ASR::down_cast(ASR::make_Variable_t(al, + x->base.base.loc, target_scope, s2c(al, x->m_name), variable_dependencies_vec.p, + variable_dependencies_vec.size(), x->m_intent, nullptr, nullptr, x->m_storage, + new_type, nullptr, x->m_abi, x->m_access, x->m_presence, x->m_value_attr)); + target_scope->add_symbol(x->m_name, s); + + return s; + } + + ASR::symbol_t* instantiate_Template(ASR::Template_t* x) { + new_scope = al.make_new(target_scope); + + // duplicate symbol table + for (auto const &sym_pair: x->m_symtab->get_scope()) { + SymbolInstantiator t(al, new_scope, type_subs, symbol_subs, + ASRUtils::symbol_name(sym_pair.second), sym_pair.second); + t.instantiate(); + } + + SetChar args; + args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + char* arg_i = x->m_args[i]; + args.push_back(al, arg_i); + } + + // TODO: fill the requires + Vec m_requires; + m_requires.reserve(al, x->n_requires); + for (size_t i=0; in_requires; i++) { + m_requires.push_back(al, duplicate_Require(ASR::down_cast(x->m_requires[i]))); + } + + ASR::asr_t *result = ASR::make_Template_t(al, x->base.base.loc, new_scope, + s2c(al, new_sym_name), args.p, args.size(), m_requires.p, m_requires.size()); + + ASR::symbol_t *t = ASR::down_cast(result); + target_scope->add_symbol(new_sym_name, t); + + return t; + } + + ASR::symbol_t* instantiate_StructType(ASR::StructType_t* x) { + new_scope = al.make_new(target_scope); + + Vec data_member_names; + data_member_names.reserve(al, x->n_members); + for (size_t i=0; in_members; i++) { + data_member_names.push_back(al, x->m_members[i]); + } + + ASR::expr_t* m_alignment = duplicate_expr(x->m_alignment); + + ASR::asr_t* result = ASR::make_StructType_t(al, x->base.base.loc, + new_scope, s2c(al, new_sym_name), nullptr, 0, data_member_names.p, + data_member_names.size(), x->m_abi, x->m_access, x->m_is_packed, + x->m_is_abstract, nullptr, 0, m_alignment, nullptr); + + ASR::symbol_t* s = ASR::down_cast(result); + target_scope->add_symbol(new_sym_name, s); + symbol_subs[x->m_name] = s; + + for (auto const &sym_pair: x->m_symtab->get_scope()) { + SymbolInstantiator t(al, new_scope, type_subs, symbol_subs, + ASRUtils::symbol_name(sym_pair.second), sym_pair.second); + t.instantiate(); + } + + return s; + } + + ASR::symbol_t* instantiate_ExternalSymbol(ASR::ExternalSymbol_t* x) { + std::string m_name = x->m_module_name; + + if (symbol_subs.find(m_name) != symbol_subs.end()) { + std::string new_m_name = ASRUtils::symbol_name(symbol_subs[m_name]); + std::string member_name = x->m_original_name; + std::string new_e_name = "1_" + new_m_name + "_" + member_name; + + if (target_scope->get_symbol(new_e_name)) { + return target_scope->get_symbol(new_e_name); + } + + ASR::symbol_t* new_m_sym = target_scope->resolve_symbol(new_m_name); + ASR::symbol_t* member_sym = ASRUtils::symbol_symtab(new_m_sym)->resolve_symbol(member_name); + + ASR::symbol_t* e = ASR::down_cast(ASR::make_ExternalSymbol_t( + al, x->base.base.loc, target_scope, s2c(al, new_e_name), member_sym, + s2c(al, new_m_name), nullptr, 0, s2c(al, member_name), x->m_access)); + target_scope->add_symbol(new_e_name, e); + symbol_subs[x->m_name] = e; + + return e; + } + + ASRUtils::SymbolDuplicator d(al); + d.duplicate_symbol(x->m_parent_symtab->get_symbol(x->m_name), target_scope); + return target_scope->get_symbol(x->m_name); + } + + ASR::symbol_t* instantiate_ClassProcedure(ASR::ClassProcedure_t* x) { + std::string new_cp_name = target_scope->parent->get_unique_name("__asr_" + std::string(x->m_name), false); + ASR::symbol_t* cp_proc = x->m_proc; + + SymbolInstantiator t(al, target_scope->parent, type_subs, symbol_subs, new_cp_name, cp_proc); + ASR::symbol_t* new_cp_proc = t.instantiate(); + symbol_subs[ASRUtils::symbol_name(cp_proc)] = new_cp_proc; + + ASR::symbol_t *new_x = ASR::down_cast(ASR::make_ClassProcedure_t( + al, x->base.base.loc, target_scope, x->m_name, x->m_self_argument, + s2c(al, new_cp_name), new_cp_proc, x->m_abi, x->m_is_deferred, x->m_is_nopass)); + target_scope->add_symbol(x->m_name, new_x); + + return new_x; + } + + ASR::symbol_t* instantiate_CustomOperator(ASR::CustomOperator_t* x) { + return new_scope->resolve_symbol(x->m_name); + } + + ASR::asr_t* duplicate_Var(ASR::Var_t *x) { + std::string sym_name = ASRUtils::symbol_name(x->m_v); + + SymbolInstantiator t(al, new_scope, type_subs, symbol_subs, sym_name, x->m_v); + ASR::symbol_t* sym = t.instantiate(); + + return ASR::make_Var_t(al, x->base.base.loc, sym); + } + + /* require */ + + ASR::require_instantiation_t* duplicate_Require(ASR::Require_t* x) { + SetChar r_args; + r_args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + char* r_arg_i = x->m_args[i]; + r_args.push_back(al, r_arg_i); + } + + return ASR::down_cast( + ASR::make_Require_t(al, x->base.base.loc, s2c(al, x->m_name), r_args.p, r_args.size())); + } + + /* utility */ + + ASR::ttype_t* substitute_type(ASR::ttype_t *ttype) { + switch (ttype->type) { + case (ASR::ttypeType::TypeParameter) : { + ASR::TypeParameter_t *param = ASR::down_cast(ttype); + return ASRUtils::duplicate_type(al, type_subs[param->m_param]); + } + case (ASR::ttypeType::List) : { + ASR::List_t *tlist = ASR::down_cast(ttype); + return ASRUtils::TYPE(ASR::make_List_t(al, ttype->base.loc, + substitute_type(tlist->m_type))); + } + case (ASR::ttypeType::Struct) : { + ASR::Struct_t *s = ASR::down_cast(ttype); + std::string struct_name = ASRUtils::symbol_name(s->m_derived_type); + if (symbol_subs.find(struct_name) != symbol_subs.end()) { + ASR::symbol_t *sym = symbol_subs[struct_name]; + return ASRUtils::TYPE(ASR::make_Struct_t(al, ttype->base.loc, sym)); + } + return ttype; + } + case (ASR::ttypeType::Array) : { + ASR::Array_t *a = ASR::down_cast(ttype); + ASR::ttype_t *t = substitute_type(a->m_type); + ASR::dimension_t* m_dims = nullptr; + size_t n_dims = ASRUtils::extract_dimensions_from_ttype(ttype, m_dims); + Vec new_dims; + new_dims.reserve(al, n_dims); + for (size_t i = 0; i < n_dims; i++) { + ASR::dimension_t old_dim = m_dims[i]; + ASR::dimension_t new_dim; + new_dim.loc = old_dim.loc; + new_dim.m_start = duplicate_expr(old_dim.m_start); + new_dim.m_length = duplicate_expr(old_dim.m_length); + new_dims.push_back(al, new_dim); + } + return ASRUtils::make_Array_t_util(al, t->base.loc, + t, new_dims.p, new_dims.size()); + } + case (ASR::ttypeType::Allocatable) : { + ASR::Allocatable_t *a = ASR::down_cast(ttype); + return ASRUtils::TYPE(ASR::make_Allocatable_t(al, ttype->base.loc, + substitute_type(a->m_type))); + } + case (ASR::ttypeType::Class) : { + ASR::Class_t *c = ASR::down_cast(ttype); + std::string class_name = ASRUtils::symbol_name(c->m_class_type); + if (symbol_subs.find(class_name) != symbol_subs.end()) { + ASR::symbol_t *new_c = symbol_subs[class_name]; + return ASRUtils::TYPE(ASR::make_Class_t(al, ttype->base.loc, new_c)); + } + return ttype; + } + default : return ttype; + } + } + +}; + +class BodyInstantiator : public ASR::BaseExprStmtDuplicator +{ +public: + SymbolTable* new_scope; + std::map type_subs; + std::map& symbol_subs; + ASR::symbol_t* new_sym; + ASR::symbol_t* sym; + SetChar dependencies; + + BodyInstantiator(Allocator &al, + std::map type_subs, + std::map& symbol_subs, + ASR::symbol_t* new_sym, ASR::symbol_t* sym): + BaseExprStmtDuplicator(al), + type_subs{type_subs}, + symbol_subs{symbol_subs}, + new_sym{new_sym}, sym{sym} + {} + + void instantiate() { + switch (sym->type) { + case (ASR::symbolType::Function) : { + LCOMPILERS_ASSERT(ASR::is_a(*new_sym)); + ASR::Function_t* x = ASR::down_cast(sym); + instantiate_Function(x); + break; + } + case (ASR::symbolType::Template) : { + LCOMPILERS_ASSERT(ASR::is_a(*new_sym)); + ASR::Template_t* x = ASR::down_cast(sym); + instantiate_Template(x); + break; + } + case (ASR::symbolType::Variable) : { + break; + } + case (ASR::symbolType::StructType) : { + LCOMPILERS_ASSERT(ASR::is_a(*new_sym)); + ASR::StructType_t* x = ASR::down_cast(sym); + instantiate_StructType(x); + break; + } + case (ASR::symbolType::ClassProcedure) : { + LCOMPILERS_ASSERT(ASR::is_a(*new_sym)); + ASR::ClassProcedure_t* x = ASR::down_cast(sym); + instantiate_ClassProcedure(x); + break; + } + case (ASR::symbolType::ExternalSymbol) : { + break; + } + case (ASR::symbolType::CustomOperator) : { + break; + } + default: { + std::string sym_name = ASRUtils::symbol_name(sym); + throw LCompilersException("Instantiation body of " + sym_name + + " symbol is not supported"); + }; + } + } + + void instantiate_Function(ASR::Function_t* x) { + ASR::Function_t* new_f = ASR::down_cast(new_sym); + new_scope = new_f->m_symtab; + + for (auto const &sym_pair: x->m_symtab->get_scope()) { + ASR::symbol_t* sym_i = sym_pair.second; + + SymbolInstantiator t_i(al, new_scope, type_subs, symbol_subs, sym_pair.first, sym_i); + ASR::symbol_t* new_sym_i = t_i.instantiate(); + + BodyInstantiator t_b(al, type_subs, symbol_subs, new_sym_i, sym_i); + t_b.instantiate(); + } + + Vec body; + body.reserve(al, x->n_body); + for (size_t i=0; in_body; i++) { + ASR::stmt_t *new_body = this->duplicate_stmt(x->m_body[i]); + if (new_body != nullptr) { + body.push_back(al, new_body); + } + } + + SetChar deps_vec; + deps_vec.reserve(al, new_f->n_dependencies + dependencies.size()); + for (size_t i=0; in_dependencies; i++) { + char* dep = new_f->m_dependencies[i]; + deps_vec.push_back(al, dep); + } + for (size_t i=0; im_body = body.p; + new_f->n_body = body.size(); + new_f->m_dependencies = deps_vec.p; + new_f->n_dependencies = deps_vec.size(); + } + + void instantiate_Template(ASR::Template_t* x) { + ASR::Template_t* new_t = ASR::down_cast(new_sym); + + for (auto const &sym_pair: new_t->m_symtab->get_scope()) { + ASR::symbol_t* new_sym_i = sym_pair.second; + ASR::symbol_t* sym_i = x->m_symtab->get_symbol(sym_pair.first); + + BodyInstantiator t(al, type_subs, symbol_subs, new_sym_i, sym_i); + t.instantiate(); + } + } + + void instantiate_StructType(ASR::StructType_t* x) { + ASR::StructType_t* new_s = ASR::down_cast(new_sym); + + for (auto const &sym_pair: new_s->m_symtab->get_scope()) { + ASR::symbol_t* new_sym_i = sym_pair.second; + ASR::symbol_t* sym_i = x->m_symtab->get_symbol(sym_pair.first); + + BodyInstantiator t(al, type_subs, symbol_subs, new_sym_i, sym_i); + t.instantiate(); + } + } + + void instantiate_ClassProcedure(ASR::ClassProcedure_t* x) { + ASR::ClassProcedure_t* new_c = ASR::down_cast(new_sym); + + ASR::symbol_t* new_proc = new_c->m_proc; + ASR::symbol_t* proc = x->m_proc; + + BodyInstantiator t(al, type_subs, symbol_subs, new_proc, proc); + t.instantiate(); + } + + /* expr */ + + ASR::asr_t* duplicate_Var(ASR::Var_t* x) { + std::string sym_name = ASRUtils::symbol_name(x->m_v); + + SymbolInstantiator t_i(al, new_scope, type_subs, symbol_subs, sym_name, x->m_v); + ASR::symbol_t* sym = t_i.instantiate(); + + BodyInstantiator t_b(al, type_subs, symbol_subs, sym, x->m_v); + t_b.instantiate(); + + return ASR::make_Var_t(al, x->base.base.loc, sym); + } + + ASR::asr_t* duplicate_FunctionCall(ASR::FunctionCall_t* x) { + Vec args; + args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + ASR::call_arg_t new_arg; + new_arg.loc = x->m_args[i].loc; + new_arg.m_value = duplicate_expr(x->m_args[i].m_value); + args.push_back(al, new_arg); + } + + ASR::ttype_t* type = substitute_type(x->m_type); + ASR::expr_t* value = duplicate_expr(x->m_value); + ASR::expr_t* dt = duplicate_expr(x->m_dt); + + std::string call_name = ASRUtils::symbol_name(x->m_name); + ASR::symbol_t* name = new_scope->resolve_symbol(call_name); + + // requirement function + if (symbol_subs.find(call_name) != symbol_subs.end()) { + name = symbol_subs[call_name]; + } + + // function call found in body that needs to be instantiated + if (name == nullptr) { + ASR::symbol_t* nested_sym = ASRUtils::symbol_symtab(sym)->resolve_symbol(call_name); + SymbolTable* target_scope = ASRUtils::symbol_parent_symtab(new_sym); + std::string nested_sym_name = target_scope->get_unique_name("__asr_" + call_name, false); + + SymbolInstantiator t_i(al, target_scope, type_subs, symbol_subs, nested_sym_name, nested_sym); + name = t_i.instantiate(); + symbol_subs[call_name] = name; + + BodyInstantiator t_b(al, type_subs, symbol_subs, name, nested_sym); + t_b.instantiate(); + } + + if (ASRUtils::symbol_parent_symtab(name)->get_counter() != new_scope->get_counter() + && !ASR::is_a(*name)) { + ADD_ASR_DEPENDENCIES(new_scope, name, dependencies); + } + + return ASRUtils::make_FunctionCall_t_util(al, x->base.base.loc, name, + x->m_original_name, args.p, args.size(), type, value, dt); + } + + ASR::asr_t* duplicate_SubroutineCall(ASR::SubroutineCall_t* x) { + Vec args; + args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + ASR::call_arg_t new_arg; + new_arg.loc = x->m_args[i].loc; + new_arg.m_value = duplicate_expr(x->m_args[i].m_value); + args.push_back(al, new_arg); + } + + ASR::expr_t* dt = duplicate_expr(x->m_dt); + + std::string call_name = ASRUtils::symbol_name(x->m_name); + ASR::symbol_t* name = new_scope->resolve_symbol(call_name); + + // requirement function + if (symbol_subs.find(call_name) != symbol_subs.end()) { + name = symbol_subs[call_name]; + } + + // function call found in body that needs to be instantiated + if (name == nullptr) { + ASR::symbol_t* nested_sym = ASRUtils::symbol_symtab(sym)->resolve_symbol(call_name); + SymbolTable* target_scope = ASRUtils::symbol_parent_symtab(new_sym); + std::string nested_sym_name = target_scope->get_unique_name("__asr_" + call_name, false); + + SymbolInstantiator t_i(al, target_scope, type_subs, symbol_subs, nested_sym_name, nested_sym); + name = t_i.instantiate(); + symbol_subs[call_name] = name; + + BodyInstantiator t_b(al, type_subs, symbol_subs, name, nested_sym); + t_b.instantiate(); + } + + if (ASRUtils::symbol_parent_symtab(name)->get_counter() != new_scope->get_counter() + && !ASR::is_a(*name)) { + ADD_ASR_DEPENDENCIES(new_scope, name, dependencies); + } + + return ASRUtils::make_SubroutineCall_t_util(al, x->base.base.loc, name, + x->m_original_name, args.p, args.size(), dt, nullptr, false, + ASRUtils::get_class_proc_nopass_val(x->m_name)); + } + + ASR::asr_t* duplicate_DoLoop(ASR::DoLoop_t *x) { + Vec m_body; + m_body.reserve(al, x->n_body); + for (size_t i=0; in_body; i++) { + m_body.push_back(al, duplicate_stmt(x->m_body[i])); + } + ASR::do_loop_head_t head; + head.m_v = duplicate_expr(x->m_head.m_v); + head.m_start = duplicate_expr(x->m_head.m_start); + head.m_end = duplicate_expr(x->m_head.m_end); + head.m_increment = duplicate_expr(x->m_head.m_increment); + head.loc = x->m_head.m_v->base.loc; + return ASR::make_DoLoop_t(al, x->base.base.loc, x->m_name, head, m_body.p, x->n_body, x->m_orelse, x->n_orelse); + } + + ASR::asr_t* duplicate_ArrayItem(ASR::ArrayItem_t *x) { + ASR::expr_t *m_v = duplicate_expr(x->m_v); + ASR::expr_t *m_value = duplicate_expr(x->m_value); + + Vec args; + args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + args.push_back(al, duplicate_array_index(x->m_args[i])); + } + + ASR::ttype_t *type = substitute_type(x->m_type); + + return ASRUtils::make_ArrayItem_t_util(al, x->base.base.loc, m_v, args.p, x->n_args, + ASRUtils::type_get_past_pointer( + ASRUtils::type_get_past_allocatable(type)), x->m_storage_format, m_value); + } + + ASR::asr_t* duplicate_ArrayConstant(ASR::ArrayConstant_t *x) { + Vec m_args; + m_args.reserve(al, x->n_args); + for (size_t i = 0; i < x->n_args; i++) { + m_args.push_back(al, self().duplicate_expr(x->m_args[i])); + } + ASR::ttype_t* m_type = substitute_type(x->m_type); + return make_ArrayConstant_t(al, x->base.base.loc, m_args.p, x->n_args, m_type, x->m_storage_format); + } + + ASR::asr_t* duplicate_ArrayPhysicalCast(ASR::ArrayPhysicalCast_t *x) { + ASR::expr_t *arg = duplicate_expr(x->m_arg); + ASR::ttype_t *ttype = substitute_type(x->m_type); + ASR::expr_t *value = duplicate_expr(x->m_value); + return ASR::make_ArrayPhysicalCast_t(al, x->base.base.loc, + arg, x->m_old, x->m_new, ttype, value); + } + + ASR::asr_t* duplicate_ArraySection(ASR::ArraySection_t *x) { + ASR::expr_t *v = duplicate_expr(x->m_v); + + Vec args; + args.reserve(al, x->n_args); + for (size_t i=0; in_args; i++) { + args.push_back(al, duplicate_array_index(x->m_args[i])); + } + + ASR::ttype_t *ttype = substitute_type(x->m_type); + ASR::expr_t *value = duplicate_expr(x->m_value); + + return ASR::make_ArraySection_t(al, x->base.base.loc, + v, args.p, args.size(), ttype, value); + } + + ASR::asr_t* duplicate_StructInstanceMember(ASR::StructInstanceMember_t *x) { + ASR::expr_t *v = duplicate_expr(x->m_v); + ASR::ttype_t *t = substitute_type(x->m_type); + ASR::expr_t *value = duplicate_expr(x->m_value); + + std::string s_name = ASRUtils::symbol_name(x->m_m); + SymbolInstantiator t_i(al, new_scope, type_subs, symbol_subs, s_name, x->m_m); + ASR::symbol_t *s = t_i.instantiate(); + + return ASR::make_StructInstanceMember_t(al, x->base.base.loc, v, s, t, value); + } + + ASR::asr_t* duplicate_ListItem(ASR::ListItem_t *x) { + ASR::expr_t *m_a = duplicate_expr(x->m_a); + ASR::expr_t *m_pos = duplicate_expr(x->m_pos); + ASR::ttype_t *type = substitute_type(x->m_type); + ASR::expr_t *m_value = duplicate_expr(x->m_value); + + return ASR::make_ListItem_t(al, x->base.base.loc, + m_a, m_pos, type, m_value); + } + + ASR::asr_t* duplicate_Cast(ASR::Cast_t *x) { + ASR::expr_t *arg = duplicate_expr(x->m_arg); + ASR::ttype_t *type = substitute_type(ASRUtils::expr_type(x->m_arg)); + if (ASRUtils::is_real(*type)) { + return (ASR::asr_t*) arg; + } + return ASRUtils::make_Cast_t_value(al, x->base.base.loc, arg, ASR::cast_kindType::IntegerToReal, x->m_type); + } + + /* stmt */ + + ASR::asr_t* duplicate_Assignment(ASR::Assignment_t *x) { + ASR::expr_t *target = duplicate_expr(x->m_target); + ASR::expr_t *value = duplicate_expr(x->m_value); + ASR::stmt_t *overloaded = duplicate_stmt(x->m_overloaded); + return ASR::make_Assignment_t(al, x->base.base.loc, target, value, overloaded); + } + + /* array_index */ + + ASR::array_index_t duplicate_array_index(ASR::array_index_t x) { + ASR::expr_t *left = duplicate_expr(x.m_left); + ASR::expr_t *right = duplicate_expr(x.m_right); + ASR::expr_t *step = duplicate_expr(x.m_step); + ASR::array_index_t result; + result.m_left = left; + result.m_right = right; + result.m_step = step; + return result; + } + + /* utility */ + + // TODO: join this with the other substitute_type + ASR::ttype_t* substitute_type(ASR::ttype_t *ttype) { + switch (ttype->type) { + case (ASR::ttypeType::TypeParameter) : { + ASR::TypeParameter_t *param = ASR::down_cast(ttype); + return ASRUtils::duplicate_type(al, type_subs[param->m_param]); + } + case (ASR::ttypeType::List) : { + ASR::List_t *tlist = ASR::down_cast(ttype); + return ASRUtils::TYPE(ASR::make_List_t(al, ttype->base.loc, + substitute_type(tlist->m_type))); + } + case (ASR::ttypeType::Struct) : { + ASR::Struct_t *s = ASR::down_cast(ttype); + std::string struct_name = ASRUtils::symbol_name(s->m_derived_type); + if (symbol_subs.find(struct_name) != symbol_subs.end()) { + ASR::symbol_t *sym = symbol_subs[struct_name]; + ttype = ASRUtils::TYPE(ASR::make_Struct_t(al, s->base.base.loc, sym)); + } + return ttype; + } + case (ASR::ttypeType::Array) : { + ASR::Array_t *a = ASR::down_cast(ttype); + ASR::ttype_t *t = substitute_type(a->m_type); + ASR::dimension_t* m_dims = nullptr; + size_t n_dims = ASRUtils::extract_dimensions_from_ttype(ttype, m_dims); + Vec new_dims; + new_dims.reserve(al, n_dims); + for (size_t i = 0; i < n_dims; i++) { + ASR::dimension_t old_dim = m_dims[i]; + ASR::dimension_t new_dim; + new_dim.loc = old_dim.loc; + new_dim.m_start = duplicate_expr(old_dim.m_start); + new_dim.m_length = duplicate_expr(old_dim.m_length); + new_dims.push_back(al, new_dim); + } + return ASRUtils::make_Array_t_util(al, t->base.loc, + t, new_dims.p, new_dims.size()); + } + case (ASR::ttypeType::Allocatable): { + ASR::Allocatable_t *a = ASR::down_cast(ttype); + return ASRUtils::TYPE(ASR::make_Allocatable_t(al, ttype->base.loc, + substitute_type(a->m_type))); + } + case (ASR::ttypeType::Class) : { + ASR::Class_t *c = ASR::down_cast(ttype); + std::string class_name = ASRUtils::symbol_name(c->m_class_type); + if (symbol_subs.find(class_name) != symbol_subs.end()) { + ASR::symbol_t *new_c = symbol_subs[class_name]; + return ASRUtils::TYPE(ASR::make_Class_t(al, ttype->base.loc, new_c)); + } + return ttype; + } + default : return ttype; + } + } +}; + +ASR::symbol_t* instantiate_symbol(Allocator &al, + SymbolTable *target_scope, + std::map type_subs, + std::map& symbol_subs, + std::string new_sym_name, ASR::symbol_t *sym) { + SymbolInstantiator t(al, target_scope, type_subs, symbol_subs, new_sym_name, sym); + return t.instantiate(); +} + +void instantiate_body(Allocator &al, + std::map type_subs, + std::map& symbol_subs, + ASR::symbol_t *new_sym, ASR::symbol_t *sym) { + BodyInstantiator t(al, type_subs, symbol_subs, new_sym, sym); + t.instantiate(); +} + +ASR::symbol_t* rename_symbol(Allocator &al, + std::map &type_subs, + SymbolTable *current_scope, + std::string new_sym_name, ASR::symbol_t *sym) { + SymbolRenamer t(al, type_subs, current_scope, new_sym_name); + return t.rename_symbol(sym); +} + +bool check_restriction(std::map type_subs, + std::map &symbol_subs, + ASR::Function_t *f, ASR::symbol_t *sym_arg, const Location &loc, + diag::Diagnostics &diagnostics, + const std::function semantic_abort, bool report=true) { + std::string f_name = f->m_name; + ASR::Function_t *arg = ASR::down_cast(ASRUtils::symbol_get_past_external(sym_arg)); + std::string arg_name = arg->m_name; + if (f->n_args != arg->n_args) { + if (report) { + std::string f_narg = std::to_string(f->n_args); + std::string arg_narg = std::to_string(arg->n_args); + diagnostics.add(diag::Diagnostic( + "Number of arguments mismatch, restriction expects a function with " + f_narg + + " parameters, but a function with " + arg_narg + " parameters is provided", + diag::Level::Error, diag::Stage::Semantic, { + diag::Label(arg_name + " has " + arg_narg + " parameters", + {loc, arg->base.base.loc}), + diag::Label(f_name + " has " + f_narg + " parameters", + {f->base.base.loc}) + } + )); + semantic_abort(); + } + return false; + } + for (size_t i = 0; i < f->n_args; i++) { + ASR::ttype_t *f_param = ASRUtils::expr_type(f->m_args[i]); + ASR::ttype_t *arg_param = ASRUtils::expr_type(arg->m_args[i]); + if (!ASRUtils::types_equal_with_substitution(f_param, arg_param, type_subs)) { + if (report) { + std::string rtype = ASRUtils::type_to_str_with_substitution(f_param, type_subs); + std::string rvar = ASRUtils::symbol_name( + ASR::down_cast(f->m_args[i])->m_v); + std::string atype = ASRUtils::type_to_str(arg_param); + std::string avar = ASRUtils::symbol_name( + ASR::down_cast(arg->m_args[i])->m_v); + diagnostics.add(diag::Diagnostic( + "Restriction type mismatch with provided function argument", + diag::Level::Error, diag::Stage::Semantic, { + diag::Label("", {loc}), + diag::Label("Restriction's parameter " + rvar + " of type " + rtype, + {f->m_args[i]->base.loc}), + diag::Label("Function's parameter " + avar + " of type " + atype, + {arg->m_args[i]->base.loc}) + } + )); + semantic_abort(); + } + return false; + } + } + if (f->m_return_var) { + if (!arg->m_return_var) { + if (report) { + std::string msg = "The restriction argument " + arg_name + + " should have a return value"; + diagnostics.add(diag::Diagnostic(msg, + diag::Level::Error, diag::Stage::Semantic, {diag::Label("", {loc})})); + semantic_abort(); + } + return false; + } + ASR::ttype_t *f_ret = ASRUtils::expr_type(f->m_return_var); + ASR::ttype_t *arg_ret = ASRUtils::expr_type(arg->m_return_var); + if (!ASRUtils::types_equal_with_substitution(f_ret, arg_ret, type_subs)) { + if (report) { + std::string rtype = ASRUtils::type_to_str_with_substitution(f_ret, type_subs); + std::string atype = ASRUtils::type_to_str(arg_ret); + diagnostics.add(diag::Diagnostic( + "Restriction type mismatch with provided function argument", + diag::Level::Error, diag::Stage::Semantic, { + diag::Label("", {loc}), + diag::Label("Requirement's return type " + rtype, + {f->m_return_var->base.loc}), + diag::Label("Function's return type " + atype, + {arg->m_return_var->base.loc}) + } + )); + semantic_abort(); + } + return false; + } + } else { + if (arg->m_return_var) { + if (report) { + std::string msg = "The restriction argument " + arg_name + + " should not have a return value"; + diagnostics.add(diag::Diagnostic(msg, + diag::Level::Error, diag::Stage::Semantic, {diag::Label("", {loc})})); + semantic_abort(); + } + return false; + } + } + symbol_subs[f_name] = sym_arg; + return true; +} + +} // namespace LFortran + } // namespace LCompilers diff --git a/src/libasr/pass/instantiate_template.h b/src/libasr/pass/instantiate_template.h index 253adc7..748f8a9 100644 --- a/src/libasr/pass/instantiate_template.h +++ b/src/libasr/pass/instantiate_template.h @@ -6,6 +6,8 @@ namespace LCompilers { +namespace LPython { + /** * @brief Instantiate a generic function into a function that does not * contain any type parameters and restrictions. No type checking @@ -39,6 +41,42 @@ namespace LCompilers { ASR::Function_t *f, ASR::symbol_t *sym_arg, const Location &loc, diag::Diagnostics &diagnostics); +} + +namespace LFortran { + + /** + * @brief Instantiate a generic function into a function that does not + * contain any type parameters and restrictions. No type checking + * is executed here + */ + ASR::symbol_t* instantiate_symbol(Allocator& al, + SymbolTable* target_scope, + std::map type_subs, + std::map& symbol_subs, + std::string new_sym_name, ASR::symbol_t* sym); + + + void instantiate_body(Allocator& al, + std::map type_subs, + std::map& symbol_subs, + ASR::symbol_t* new_sym, ASR::symbol_t* sym); + + + ASR::symbol_t* rename_symbol(Allocator &al, + std::map &type_subs, + SymbolTable *current_scope, + std::string new_sym_name, ASR::symbol_t *sym); + + + bool check_restriction(std::map type_subs, + std::map &symbol_subs, + ASR::Function_t *f, ASR::symbol_t *sym_arg, const Location &loc, + diag::Diagnostics &diagnostics, + const std::function semantic_abort, bool report=true); + +} + } // namespace LCompilers #endif // LIBASR_PASS_INSTANTIATE_TEMPLATE_H diff --git a/src/libasr/pass/intrinsic_array_function_registry.h b/src/libasr/pass/intrinsic_array_function_registry.h index 3c3bca0..ca21031 100644 --- a/src/libasr/pass/intrinsic_array_function_registry.h +++ b/src/libasr/pass/intrinsic_array_function_registry.h @@ -9,6 +9,7 @@ #include #include +#include #include namespace LCompilers { @@ -27,6 +28,11 @@ enum class IntrinsicArrayFunctions : int64_t { Product, Shape, Sum, + Transpose, + Pack, + Unpack, + Count, + DotProduct, // ... }; @@ -47,6 +53,11 @@ inline std::string get_array_intrinsic_name(int x) { ARRAY_INTRINSIC_NAME_CASE(Product) ARRAY_INTRINSIC_NAME_CASE(Shape) ARRAY_INTRINSIC_NAME_CASE(Sum) + ARRAY_INTRINSIC_NAME_CASE(Transpose) + ARRAY_INTRINSIC_NAME_CASE(Pack) + ARRAY_INTRINSIC_NAME_CASE(Unpack) + ARRAY_INTRINSIC_NAME_CASE(Count) + ARRAY_INTRINSIC_NAME_CASE(DotProduct) default : { throw LCompilersException("pickle: intrinsic_id not implemented"); } @@ -64,6 +75,180 @@ typedef void (*verify_array_function)( const ASR::IntrinsicArrayFunction_t&, diag::Diagnostics&); +namespace Merge { + + static inline void verify_args(const ASR::IntrinsicArrayFunction_t& x, + diag::Diagnostics& diagnostics) { + const Location& loc = x.base.base.loc; + ASR::expr_t *tsource = x.m_args[0], *fsource = x.m_args[1], *mask = x.m_args[2]; + ASR::ttype_t *tsource_type = ASRUtils::expr_type(tsource); + ASR::ttype_t *fsource_type = ASRUtils::expr_type(fsource); + ASR::ttype_t *mask_type = ASRUtils::expr_type(mask); + int tsource_ndims, fsource_ndims; + ASR::dimension_t *tsource_mdims = nullptr, *fsource_mdims = nullptr; + tsource_ndims = ASRUtils::extract_dimensions_from_ttype(tsource_type, tsource_mdims); + fsource_ndims = ASRUtils::extract_dimensions_from_ttype(fsource_type, fsource_mdims); + if( tsource_ndims > 0 && fsource_ndims > 0 ) { + ASRUtils::require_impl(tsource_ndims == fsource_ndims, + "All arguments of `merge` should be of same rank and dimensions", loc, diagnostics); + + if( ASRUtils::extract_physical_type(tsource_type) == ASR::array_physical_typeType::FixedSizeArray && + ASRUtils::extract_physical_type(fsource_type) == ASR::array_physical_typeType::FixedSizeArray ) { + ASRUtils::require_impl(ASRUtils::get_fixed_size_of_array(tsource_mdims, tsource_ndims) == + ASRUtils::get_fixed_size_of_array(fsource_mdims, fsource_ndims), + "`tsource` and `fsource` arguments should have matching size", loc, diagnostics); + } + } + + ASRUtils::require_impl(ASRUtils::check_equal_type(tsource_type, fsource_type), + "`tsource` and `fsource` arguments to `merge` should be of same type, found " + + ASRUtils::get_type_code(tsource_type) + ", " + + ASRUtils::get_type_code(fsource_type), loc, diagnostics); + ASRUtils::require_impl(ASRUtils::is_logical(*mask_type), + "`mask` argument to `merge` should be of logical type, found " + + ASRUtils::get_type_code(mask_type), loc, diagnostics); + } + + static inline ASR::expr_t* eval_Merge( + Allocator &/*al*/, const Location &/*loc*/, ASR::ttype_t *, + Vec& args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(args.size() == 3); + ASR::expr_t *tsource = args[0], *fsource = args[1], *mask = args[2]; + if( ASRUtils::is_array(ASRUtils::expr_type(mask)) ) { + return nullptr; + } + + bool mask_value = false; + if( ASRUtils::is_value_constant(mask, mask_value) ) { + if( mask_value ) { + return tsource; + } else { + return fsource; + } + } + return nullptr; + } + + static inline ASR::asr_t* create_Merge(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if( args.size() != 3 ) { + append_error(diag, "`merge` intrinsic accepts 3 positional arguments, found " + + std::to_string(args.size()), loc); + return nullptr; + } + + ASR::expr_t *tsource = args[0], *fsource = args[1], *mask = args[2]; + ASR::ttype_t *tsource_type = ASRUtils::expr_type(tsource); + ASR::ttype_t *fsource_type = ASRUtils::expr_type(fsource); + ASR::ttype_t *mask_type = ASRUtils::expr_type(mask); + ASR::ttype_t* result_type = tsource_type; + int tsource_ndims, fsource_ndims, mask_ndims; + ASR::dimension_t *tsource_mdims = nullptr, *fsource_mdims = nullptr, *mask_mdims = nullptr; + tsource_ndims = ASRUtils::extract_dimensions_from_ttype(tsource_type, tsource_mdims); + fsource_ndims = ASRUtils::extract_dimensions_from_ttype(fsource_type, fsource_mdims); + mask_ndims = ASRUtils::extract_dimensions_from_ttype(mask_type, mask_mdims); + if( tsource_ndims > 0 && fsource_ndims > 0 ) { + if( tsource_ndims != fsource_ndims ) { + append_error(diag, "All arguments of `merge` should be of same rank and dimensions", loc); + return nullptr; + } + + if( ASRUtils::extract_physical_type(tsource_type) == ASR::array_physical_typeType::FixedSizeArray && + ASRUtils::extract_physical_type(fsource_type) == ASR::array_physical_typeType::FixedSizeArray && + ASRUtils::get_fixed_size_of_array(tsource_mdims, tsource_ndims) != + ASRUtils::get_fixed_size_of_array(fsource_mdims, fsource_ndims) ) { + append_error(diag, "`tsource` and `fsource` arguments should have matching size", loc); + return nullptr; + } + } else { + if( tsource_ndims > 0 && fsource_ndims == 0 ) { + result_type = tsource_type; + } else if( tsource_ndims == 0 && fsource_ndims > 0 ) { + result_type = fsource_type; + } else if( tsource_ndims == 0 && fsource_ndims == 0 && mask_ndims > 0 ) { + Vec mask_mdims_vec; + mask_mdims_vec.from_pointer_n(mask_mdims, mask_ndims); + result_type = ASRUtils::duplicate_type(al, tsource_type, &mask_mdims_vec, + ASRUtils::extract_physical_type(mask_type), true); + if( ASR::is_a(*mask_type) ) { + result_type = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, result_type)); + } + } + } + if( !ASRUtils::check_equal_type(tsource_type, fsource_type) ) { + append_error(diag, "`tsource` and `fsource` arguments to `merge` should be of same type, found " + + ASRUtils::get_type_code(tsource_type) + ", " + + ASRUtils::get_type_code(fsource_type), loc); + return nullptr; + } + if( !ASRUtils::is_logical(*mask_type) ) { + append_error(diag, "`mask` argument to `merge` should be of logical type, found " + + ASRUtils::get_type_code(mask_type), loc); + return nullptr; + } + + return ASR::make_IntrinsicArrayFunction_t(al, loc, + static_cast(ASRUtils::IntrinsicArrayFunctions::Merge), + args.p, args.size(), 0, result_type, nullptr); + } + + static inline ASR::expr_t* instantiate_Merge(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + LCOMPILERS_ASSERT(arg_types.size() == 3); + + // Array inputs should be elementalised in array_op pass already + LCOMPILERS_ASSERT( !ASRUtils::is_array(arg_types[2]) ); + ASR::ttype_t *tsource_type = ASRUtils::duplicate_type(al, arg_types[0]); + ASR::ttype_t *fsource_type = ASRUtils::duplicate_type(al, arg_types[1]); + ASR::ttype_t *mask_type = ASRUtils::duplicate_type(al, arg_types[2]); + if( ASR::is_a(*tsource_type) ) { + ASR::Character_t* tsource_char = ASR::down_cast(tsource_type); + ASR::Character_t* fsource_char = ASR::down_cast(fsource_type); + tsource_char->m_len_expr = nullptr; fsource_char->m_len_expr = nullptr; + tsource_char->m_len = -2; fsource_char->m_len = -2; + ASR::Character_t* return_char = ASR::down_cast( + ASRUtils::type_get_past_allocatable(return_type)); + return_char->m_len = -2; return_char->m_len_expr = nullptr; + + } + std::string new_name = "_lcompilers_merge_" + get_type_code(tsource_type); + + declare_basic_variables(new_name); + if (scope->get_symbol(new_name)) { + ASR::symbol_t *s = scope->get_symbol(new_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); + } + + auto tsource_arg = declare("tsource", tsource_type, In); + args.push_back(al, tsource_arg); + auto fsource_arg = declare("fsource", fsource_type, In); + args.push_back(al, fsource_arg); + auto mask_arg = declare("mask", mask_type, In); + args.push_back(al, mask_arg); + // TODO: In case of Character type, set len of ReturnVar to len(tsource) expression + auto result = declare("merge", type_get_past_allocatable(return_type), ReturnVar); + + { + Vec if_body; if_body.reserve(al, 1); + if_body.push_back(al, b.Assignment(result, tsource_arg)); + Vec else_body; else_body.reserve(al, 1); + else_body.push_back(al, b.Assignment(result, fsource_arg)); + body.push_back(al, STMT(ASR::make_If_t(al, loc, mask_arg, + if_body.p, if_body.n, else_body.p, else_body.n))); + } + + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.Call(new_symbol, new_args, return_type, nullptr); + } + +} // namespace Merge + namespace ArrIntrinsic { static inline void verify_array_int_real_cmplx(ASR::expr_t* array, ASR::ttype_t* return_type, @@ -189,13 +374,14 @@ static inline void verify_args(const ASR::IntrinsicArrayFunction_t& x, diag::Dia } static inline ASR::expr_t *eval_ArrIntrinsic(Allocator & /*al*/, - const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/) { + const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/, + diag::Diagnostics& /*diag*/) { return nullptr; } static inline ASR::asr_t* create_ArrIntrinsic( Allocator& al, const Location& loc, Vec& args, - const std::function err, + diag::Diagnostics& diag, ASRUtils::IntrinsicArrayFunctions intrinsic_func_id) { std::string intrinsic_func_name = ASRUtils::get_array_intrinsic_name(static_cast(intrinsic_func_id)); int64_t id_array = 0, id_array_dim = 1, id_array_mask = 2; @@ -230,13 +416,15 @@ static inline ASR::asr_t* create_ArrIntrinsic( size_t arg3_rank = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(arg3)); if( arg2_rank != 0 ) { - err("dim argument to " + intrinsic_func_name + " must be a scalar and must not be an array", + append_error(diag, "dim argument to " + intrinsic_func_name + " must be a scalar and must not be an array", arg2->base.loc); + return nullptr; } if( arg3_rank == 0 ) { - err("mask argument to " + intrinsic_func_name + " must be an array and must not be a scalar", + append_error(diag, "mask argument to " + intrinsic_func_name + " must be an array and must not be a scalar", arg3->base.loc); + return nullptr; } overload_id = id_array_dim_mask; @@ -246,12 +434,14 @@ static inline ASR::asr_t* create_ArrIntrinsic( // if axis is available at compile time ASR::expr_t *value = nullptr; + bool runtime_dim = false; Vec arg_values; arg_values.reserve(al, 3); ASR::expr_t *array_value = ASRUtils::expr_value(array); arg_values.push_back(al, array_value); if( arg2 ) { ASR::expr_t *arg2_value = ASRUtils::expr_value(arg2); + runtime_dim = arg2_value == nullptr; arg_values.push_back(al, arg2_value); } if( arg3 ) { @@ -272,16 +462,22 @@ static inline ASR::asr_t* create_ArrIntrinsic( Vec dims; size_t n_dims = ASRUtils::extract_n_dims_from_ttype(array_type); dims.reserve(al, (int) n_dims - 1); - for( int i = 0; i < (int) n_dims - 1; i++ ) { + for( int it = 0; it < (int) n_dims - 1; it++ ) { + Vec args_merge; args_merge.reserve(al, 3); + ASRUtils::ASRBuilder b(al, loc); + args_merge.push_back(al, b.ArraySize(args[0], b.i32(it+1), int32)); + args_merge.push_back(al, b.ArraySize(args[0], b.i32(it+2), int32)); + args_merge.push_back(al, b.iLt(b.i32(it+1), args[1])); + ASR::expr_t* merge = EXPR(Merge::create_Merge(al, loc, args_merge, diag)); ASR::dimension_t dim; dim.loc = array->base.loc; - dim.m_length = nullptr; - dim.m_start = nullptr; + dim.m_start = b.i32(1); + dim.m_length = runtime_dim ? merge : nullptr; dims.push_back(al, dim); } - return_type = ASRUtils::duplicate_type(al, array_type, &dims); + return_type = ASRUtils::duplicate_type(al, array_type, &dims, ASR::array_physical_typeType::DescriptorArray, true); } - value = eval_ArrIntrinsic(al, loc, return_type, arg_values); + value = eval_ArrIntrinsic(al, loc, return_type, arg_values, diag); Vec arr_intrinsic_args; arr_intrinsic_args.reserve(al, 3); @@ -488,7 +684,26 @@ static inline ASR::expr_t* instantiate_ArrIntrinsic(Allocator &al, int result_dims = extract_n_dims_from_ttype(return_type); ASR::expr_t* return_var = nullptr; if( result_dims > 0 ) { - fill_func_arg("result", return_type) + ASR::ttype_t* return_type_ = return_type; + if( !ASRUtils::is_fixed_size_array(return_type) ) { + bool is_allocatable = ASRUtils::is_allocatable(return_type); + Vec empty_dims; + empty_dims.reserve(al, result_dims); + for( int idim = 0; idim < result_dims; idim++ ) { + ASR::dimension_t empty_dim; + empty_dim.loc = loc; + empty_dim.m_start = nullptr; + empty_dim.m_length = nullptr; + empty_dims.push_back(al, empty_dim); + } + return_type_ = ASRUtils::make_Array_t_util(al, loc, + ASRUtils::extract_type(return_type_), empty_dims.p, empty_dims.size()); + if( is_allocatable ) { + return_type_ = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, return_type_)); + } + } + ASR::expr_t *result = declare("result", return_type_, Out); + args.push_back(al, result); } else if( result_dims == 0 ) { return_var = declare("result", return_type, ReturnVar); } @@ -567,9 +782,9 @@ static inline ASR::expr_t *eval_MaxMinLoc(Allocator &al, const Location &loc, std::min_element(m_eles.begin(), m_eles.end())) + 1; } if (!is_array(type)) { - return i(index, type); + return b.i(index, type); } else { - return b.ArrayConstant({i32(index)}, extract_type(type), false); + return b.ArrayConstant({b.i32(index)}, extract_type(type), false); } } else { return nullptr; @@ -578,16 +793,20 @@ static inline ASR::expr_t *eval_MaxMinLoc(Allocator &al, const Location &loc, static inline ASR::asr_t* create_MaxMinLoc(Allocator& al, const Location& loc, Vec& args, int intrinsic_id, - const std::function err) { + diag::Diagnostics& diag) { std::string intrinsic_name = get_array_intrinsic_name(static_cast(intrinsic_id)); + ASRUtils::ASRBuilder b(al, loc); ASR::ttype_t *array_type = expr_type(args[0]); if ( !is_array(array_type) ) { - err("`array` argument of `"+ intrinsic_name +"` must be an array", loc); + append_error(diag, "`array` argument of `"+ intrinsic_name +"` must be an array", loc); + return nullptr; } else if ( !is_integer(*array_type) && !is_real(*array_type) ) { - err("`array` argument of `"+ intrinsic_name +"` must be integer or " + append_error(diag, "`array` argument of `"+ intrinsic_name +"` must be integer or " "real for now", loc); + return nullptr; } else if ( args[2] || args[4] ) { - err("`mask` and `back` keyword argument is not supported yet", loc); + append_error(diag, "`mask` and `back` keyword argument is not supported yet", loc); + return nullptr; } ASR::ttype_t *return_type = nullptr; Vec m_args; m_args.reserve(al, 1); @@ -598,18 +817,22 @@ static inline ASR::asr_t* create_MaxMinLoc(Allocator& al, const Location& loc, int dim = 0, kind = 4; // default kind if (args[3]) { if (!extract_value(expr_value(args[3]), kind)) { - err("Runtime value for `kind` argument is not supported yet", loc); + append_error(diag, "Runtime value for `kind` argument is not supported yet", loc); + return nullptr; } } if ( args[1] ) { if ( !ASR::is_a(*expr_type(args[1])) ) { - err("`dim` should be a scalar integer type", loc); + append_error(diag, "`dim` should be a scalar integer type", loc); + return nullptr; } else if (!extract_value(expr_value(args[1]), dim)) { - err("Runtime values for `dim` argument is not supported yet", loc); + append_error(diag, "Runtime values for `dim` argument is not supported yet", loc); + return nullptr; } if ( 1 > dim || dim > n_dims ) { - err("`dim` argument of `"+ intrinsic_name +"` is out of " + append_error(diag, "`dim` argument of `"+ intrinsic_name +"` is out of " "array index range", loc); + return nullptr; } if ( n_dims == 1 ) { return_type = TYPE(ASR::make_Integer_t(al, loc, kind)); // 1D @@ -629,8 +852,8 @@ static inline ASR::asr_t* create_MaxMinLoc(Allocator& al, const Location& loc, } else { ASR::dimension_t tmp_dim; tmp_dim.loc = args[0]->base.loc; - tmp_dim.m_start = i32(1); - tmp_dim.m_length = i32(n_dims); + tmp_dim.m_start = b.i32(1); + tmp_dim.m_length = b.i32(n_dims); result_dims.push_back(al, tmp_dim); } if ( !return_type ) { @@ -677,15 +900,15 @@ static inline ASR::expr_t *instantiate_MaxMinLoc(Allocator &al, b.generate_reduction_intrinsic_stmts_for_scalar_output( loc, args[0], fn_symtab, body, idx_vars, doloop_body, [=, &al, &body, &b] () { - body.push_back(al, b.Assignment(result, i(1, type))); + body.push_back(al, b.Assignment(result, b.i(1, type))); }, [=, &al, &b, &idx_vars, &doloop_body] () { std::vector if_body; if_body.reserve(n_dims); Vec result_idx; result_idx.reserve(al, n_dims); for (int i = 0; i < n_dims; i++) { - ASR::expr_t *idx = b.ArrayItem_01(result, {i32(i+1)}); + ASR::expr_t *idx = b.ArrayItem_01(result, {b.i32(i+1)}); if (extract_kind_from_ttype_t(type) != 4) { - if_body.push_back(b.Assignment(idx, i2i(idx_vars[i], type))); - result_idx.push_back(al, i2i32(idx)); + if_body.push_back(b.Assignment(idx, b.i2i(idx_vars[i], type))); + result_idx.push_back(al, b.i2i32(idx)); } else { if_body.push_back(b.Assignment(idx, idx_vars[i])); result_idx.push_back(al, idx); @@ -708,14 +931,14 @@ static inline ASR::expr_t *instantiate_MaxMinLoc(Allocator &al, loc, args[0], args[1], fn_symtab, body, idx_vars, target_idx_vars, doloop_body, [=, &al, &body, &b] () { - body.push_back(al, b.Assignment(result, i(1, type))); + body.push_back(al, b.Assignment(result, b.i(1, type))); }, [=, &al, &b, &idx_vars, &target_idx_vars, &doloop_body] () { ASR::expr_t *result_ref, *array_ref_02; if (is_array(return_type)) { result_ref = ArrayItem_02(result, target_idx_vars); Vec tmp_idx_vars; tmp_idx_vars.from_pointer_n_copy(al, idx_vars.p, idx_vars.n); - tmp_idx_vars.p[dim - 1] = i2i32(result_ref); + tmp_idx_vars.p[dim - 1] = b.i2i32(result_ref); array_ref_02 = ArrayItem_02(args[0], tmp_idx_vars); } else { // 1D scalar output @@ -725,7 +948,7 @@ static inline ASR::expr_t *instantiate_MaxMinLoc(Allocator &al, ASR::expr_t *array_ref_01 = ArrayItem_02(args[0], idx_vars); ASR::expr_t *res_idx = idx_vars.p[dim - 1]; if (extract_kind_from_ttype_t(type) != 4) { - res_idx = i2i(res_idx, type); + res_idx = b.i2i(res_idx, type); } if (static_cast(IntrinsicArrayFunctions::MaxLoc) == intrinsic_id) { doloop_body.push_back(al, b.If(b.Gt(array_ref_01, array_ref_02), { @@ -750,60 +973,71 @@ static inline ASR::expr_t *instantiate_MaxMinLoc(Allocator &al, namespace Shape { static inline void verify_args(const ASR::IntrinsicArrayFunction_t &x, diag::Diagnostics &diagnostics) { - ASRUtils::require_impl(x.n_args == 1 || x.n_args == 2, - "`shape` intrinsic accepts either 1 or 2 arguments", + ASRUtils::require_impl(x.n_args == 1, + "`shape` intrinsic accepts 1 argument", x.base.base.loc, diagnostics); ASRUtils::require_impl(x.m_args[0], "`source` argument of `shape` " "cannot be nullptr", x.base.base.loc, diagnostics); - ASRUtils::require_impl(x.m_args[1], "`kind` argument of `shape` " - "cannot be nullptr", x.base.base.loc, diagnostics); } static ASR::expr_t *eval_Shape(Allocator &al, const Location &loc, - ASR::ttype_t *type, Vec &args) { + ASR::ttype_t *type, Vec &args, diag::Diagnostics& /*diag*/) { ASR::dimension_t *m_dims; size_t n_dims = extract_dimensions_from_ttype(expr_type(args[0]), m_dims); Vec m_shapes; m_shapes.reserve(al, n_dims); - for (size_t i = 0; i < n_dims; i++) { - if (m_dims[i].m_length) { - ASR::expr_t *e = nullptr; - if (extract_kind_from_ttype_t(type) != 4) { - e = i2i(m_dims[i].m_length, extract_type(type)); - } else { - e = m_dims[i].m_length; + if( n_dims == 0 ){ + return EXPR(ASR::make_ArrayConstant_t(al, loc, m_shapes.p, 0, + type, ASR::arraystorageType::ColMajor)); + } else { + for (size_t i = 0; i < n_dims; i++) { + if (m_dims[i].m_length) { + ASR::expr_t *e = nullptr; + if (extract_kind_from_ttype_t(type) != 4) { + ASRUtils::ASRBuilder b(al, loc); + e = b.i2i(m_dims[i].m_length, extract_type(type)); + } else { + e = m_dims[i].m_length; + } + m_shapes.push_back(al, e); } - m_shapes.push_back(al, e); } } ASR::expr_t *value = nullptr; + bool all_args_evaluated_ = all_args_evaluated(m_shapes); if (m_shapes.n > 0) { - value = EXPR(ASR::make_ArrayConstant_t(al, loc, m_shapes.p, m_shapes.n, - type, ASR::arraystorageType::ColMajor)); + if (all_args_evaluated_) { + value = EXPR(ASR::make_ArrayConstant_t(al, loc, m_shapes.p, m_shapes.n, + type, ASR::arraystorageType::ColMajor)); + } else { + value = EXPR(ASR::make_ArrayConstructor_t(al, loc, m_shapes.p, m_shapes.n, + type, nullptr, ASR::arraystorageType::ColMajor)); + } } return value; } static inline ASR::asr_t* create_Shape(Allocator& al, const Location& loc, Vec& args, - const std::function err) { + diag::Diagnostics& diag) { ASRBuilder b(al, loc); Vecm_args; m_args.reserve(al, 1); m_args.push_back(al, args[0]); int kind = 4; // default kind if (args[1]) { if (!ASR::is_a(*expr_type(args[1]))) { - err("`kind` argument of `shape` must be a scalar integer", loc); + append_error(diag, "`kind` argument of `shape` must be a scalar integer", loc); + return nullptr; } if (!extract_value(args[1], kind)) { - err("Only constant value for `kind` is supported for now", loc); + append_error(diag, "Only constant value for `kind` is supported for now", loc); + return nullptr; } } // TODO: throw error for assumed size array int n_dims = extract_n_dims_from_ttype(expr_type(args[0])); ASR::ttype_t *return_type = b.Array({n_dims}, TYPE(ASR::make_Integer_t(al, loc, kind))); - ASR::expr_t *m_value = eval_Shape(al, loc, return_type, args); - + ASR::expr_t *m_value = eval_Shape(al, loc, return_type, args, diag); return ASRUtils::make_IntrinsicArrayFunction_t_util(al, loc, static_cast(ASRUtils::IntrinsicArrayFunctions::Shape), m_args.p, m_args.n, 0, return_type, m_value); @@ -818,14 +1052,13 @@ namespace Shape { auto result = declare(fn_name, return_type, ReturnVar); int iter = extract_n_dims_from_ttype(arg_types[0]) + 1; auto i = declare("i", int32, Local); - body.push_back(al, b.Assignment(i, i32(1))); - body.push_back(al, b.While(iLt(i, i32(iter)), { + body.push_back(al, b.Assignment(i, b.i32(1))); + body.push_back(al, b.While(b.iLt(i, b.i32(iter)), { b.Assignment(b.ArrayItem_01(result, {i}), - ArraySize_2(args[0], i, extract_type(return_type))), - b.Assignment(i, iAdd(i, i32(1))) + b.ArraySize_2(args[0], i, extract_type(return_type))), + b.Assignment(i, b.iAdd(i, b.i32(1))) })); body.push_back(al, Return()); - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); scope->add_symbol(fn_name, f_sym); @@ -900,13 +1133,14 @@ namespace Any { } static inline ASR::expr_t *eval_Any(Allocator & /*al*/, - const Location & /*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/) { + const Location & /*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/, + diag::Diagnostics& /*diag*/) { return nullptr; } static inline ASR::asr_t* create_Any( Allocator& al, const Location& loc, Vec& args, - const std::function err) { + diag::Diagnostics& diag) { int64_t overload_id = 0; Vec any_args; any_args.reserve(al, 2); @@ -917,8 +1151,9 @@ namespace Any { axis = args[1]; } if( ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(array)) == 0 ) { - err("mask argument to any must be an array and must not be a scalar", + append_error(diag, "mask argument to any must be an array and must not be a scalar", array->base.loc); + return nullptr; } // TODO: Add a check for range of values axis can take @@ -958,7 +1193,7 @@ namespace Any { logical_return_type = ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)); } } - value = eval_Any(al, loc, logical_return_type, arg_values); + value = eval_Any(al, loc, logical_return_type, arg_values, diag); any_args.push_back(al, array); if( axis ) { @@ -986,7 +1221,7 @@ namespace Any { }, [=, &al, &idx_vars, &doloop_body, &builder] () { ASR::expr_t* array_ref = PassUtils::create_array_ref(array, idx_vars, al); - ASR::expr_t* logical_or = builder.Or(return_var, array_ref, loc); + ASR::expr_t* logical_or = builder.LogicalOr(return_var, array_ref, loc); ASR::stmt_t* loop_invariant = builder.Assignment(return_var, logical_or); doloop_body.push_back(al, loop_invariant); } @@ -1123,14 +1358,15 @@ namespace Sum { } static inline ASR::expr_t *eval_Sum(Allocator & /*al*/, - const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/) { + const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/, + diag::Diagnostics& /*diag*/) { return nullptr; } static inline ASR::asr_t* create_Sum(Allocator& al, const Location& loc, Vec& args, - const std::function err) { - return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, err, + diag::Diagnostics& diag) { + return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, diag, IntrinsicArrayFunctions::Sum); } @@ -1154,14 +1390,15 @@ namespace Product { } static inline ASR::expr_t *eval_Product(Allocator & /*al*/, - const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/) { + const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/, + diag::Diagnostics& /*diag*/) { return nullptr; } static inline ASR::asr_t* create_Product(Allocator& al, const Location& loc, Vec& args, - const std::function err) { - return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, err, + diag::Diagnostics& diag) { + return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, diag, IntrinsicArrayFunctions::Product); } @@ -1185,14 +1422,15 @@ namespace MaxVal { } static inline ASR::expr_t *eval_MaxVal(Allocator & /*al*/, - const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/) { + const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/, + diag::Diagnostics& /*diag*/) { return nullptr; } static inline ASR::asr_t* create_MaxVal(Allocator& al, const Location& loc, Vec& args, - const std::function err) { - return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, err, + diag::Diagnostics& diag) { + return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, diag, IntrinsicArrayFunctions::MaxVal); } @@ -1216,9 +1454,9 @@ namespace MaxLoc { static inline ASR::asr_t* create_MaxLoc(Allocator& al, const Location& loc, Vec& args, - const std::function err) { + diag::Diagnostics& diag) { return ArrIntrinsic::create_MaxMinLoc(al, loc, args, - static_cast(IntrinsicArrayFunctions::MaxLoc), err); + static_cast(IntrinsicArrayFunctions::MaxLoc), diag); } static inline ASR::expr_t *instantiate_MaxLoc(Allocator &al, @@ -1232,201 +1470,37 @@ namespace MaxLoc { } // namespace MaxLoc -namespace Merge { +namespace MinVal { static inline void verify_args(const ASR::IntrinsicArrayFunction_t& x, diag::Diagnostics& diagnostics) { - const Location& loc = x.base.base.loc; - ASR::expr_t *tsource = x.m_args[0], *fsource = x.m_args[1], *mask = x.m_args[2]; - ASR::ttype_t *tsource_type = ASRUtils::expr_type(tsource); - ASR::ttype_t *fsource_type = ASRUtils::expr_type(fsource); - ASR::ttype_t *mask_type = ASRUtils::expr_type(mask); - int tsource_ndims, fsource_ndims; - ASR::dimension_t *tsource_mdims = nullptr, *fsource_mdims = nullptr; - tsource_ndims = ASRUtils::extract_dimensions_from_ttype(tsource_type, tsource_mdims); - fsource_ndims = ASRUtils::extract_dimensions_from_ttype(fsource_type, fsource_mdims); - if( tsource_ndims > 0 && fsource_ndims > 0 ) { - ASRUtils::require_impl(tsource_ndims == fsource_ndims, - "All arguments of `merge` should be of same rank and dimensions", loc, diagnostics); - - if( ASRUtils::extract_physical_type(tsource_type) == ASR::array_physical_typeType::FixedSizeArray && - ASRUtils::extract_physical_type(fsource_type) == ASR::array_physical_typeType::FixedSizeArray ) { - ASRUtils::require_impl(ASRUtils::get_fixed_size_of_array(tsource_mdims, tsource_ndims) == - ASRUtils::get_fixed_size_of_array(fsource_mdims, fsource_ndims), - "`tsource` and `fsource` arguments should have matching size", loc, diagnostics); - } - } + ArrIntrinsic::verify_args(x, diagnostics, IntrinsicArrayFunctions::MinVal, + &ArrIntrinsic::verify_array_int_real); + } - ASRUtils::require_impl(ASRUtils::check_equal_type(tsource_type, fsource_type), - "`tsource` and `fsource` arguments to `merge` should be of same type, found " + - ASRUtils::get_type_code(tsource_type) + ", " + - ASRUtils::get_type_code(fsource_type), loc, diagnostics); - ASRUtils::require_impl(ASRUtils::is_logical(*mask_type), - "`mask` argument to `merge` should be of logical type, found " + - ASRUtils::get_type_code(mask_type), loc, diagnostics); + static inline ASR::expr_t *eval_MinVal(Allocator & /*al*/, + const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/, + diag::Diagnostics& /*diag*/) { + return nullptr; } - static inline ASR::expr_t* eval_Merge( - Allocator &/*al*/, const Location &/*loc*/, ASR::ttype_t *, - Vec& args) { - LCOMPILERS_ASSERT(args.size() == 3); - ASR::expr_t *tsource = args[0], *fsource = args[1], *mask = args[2]; - if( ASRUtils::is_array(ASRUtils::expr_type(mask)) ) { - return nullptr; - } + static inline ASR::asr_t* create_MinVal(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, diag, + IntrinsicArrayFunctions::MinVal); + } - bool mask_value = false; - if( ASRUtils::is_value_constant(mask, mask_value) ) { - if( mask_value ) { - return tsource; - } else { - return fsource; - } - } - return nullptr; + static inline ASR::expr_t* instantiate_MinVal(Allocator &al, + const Location &loc, SymbolTable *scope, Vec& arg_types, + ASR::ttype_t *return_type, Vec& new_args, + int64_t overload_id) { + return ArrIntrinsic::instantiate_ArrIntrinsic(al, loc, scope, arg_types, + return_type, new_args, overload_id, IntrinsicArrayFunctions::MinVal, + &get_maximum_value_with_given_type, &ASRBuilder::ElementalMin); } - static inline ASR::asr_t* create_Merge(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if( args.size() != 3 ) { - err("`merge` intrinsic accepts 3 positional arguments, found " + - std::to_string(args.size()), loc); - } - - ASR::expr_t *tsource = args[0], *fsource = args[1], *mask = args[2]; - ASR::ttype_t *tsource_type = ASRUtils::expr_type(tsource); - ASR::ttype_t *fsource_type = ASRUtils::expr_type(fsource); - ASR::ttype_t *mask_type = ASRUtils::expr_type(mask); - ASR::ttype_t* result_type = tsource_type; - int tsource_ndims, fsource_ndims, mask_ndims; - ASR::dimension_t *tsource_mdims = nullptr, *fsource_mdims = nullptr, *mask_mdims = nullptr; - tsource_ndims = ASRUtils::extract_dimensions_from_ttype(tsource_type, tsource_mdims); - fsource_ndims = ASRUtils::extract_dimensions_from_ttype(fsource_type, fsource_mdims); - mask_ndims = ASRUtils::extract_dimensions_from_ttype(mask_type, mask_mdims); - if( tsource_ndims > 0 && fsource_ndims > 0 ) { - if( tsource_ndims != fsource_ndims ) { - err("All arguments of `merge` should be of same rank and dimensions", loc); - } - - if( ASRUtils::extract_physical_type(tsource_type) == ASR::array_physical_typeType::FixedSizeArray && - ASRUtils::extract_physical_type(fsource_type) == ASR::array_physical_typeType::FixedSizeArray && - ASRUtils::get_fixed_size_of_array(tsource_mdims, tsource_ndims) != - ASRUtils::get_fixed_size_of_array(fsource_mdims, fsource_ndims) ) { - err("`tsource` and `fsource` arguments should have matching size", loc); - } - } else { - if( tsource_ndims > 0 && fsource_ndims == 0 ) { - result_type = tsource_type; - } else if( tsource_ndims == 0 && fsource_ndims > 0 ) { - result_type = fsource_type; - } else if( tsource_ndims == 0 && fsource_ndims == 0 && mask_ndims > 0 ) { - Vec mask_mdims_vec; - mask_mdims_vec.from_pointer_n(mask_mdims, mask_ndims); - result_type = ASRUtils::duplicate_type(al, tsource_type, &mask_mdims_vec, - ASRUtils::extract_physical_type(mask_type), true); - if( ASR::is_a(*mask_type) ) { - result_type = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, result_type)); - } - } - } - if( !ASRUtils::check_equal_type(tsource_type, fsource_type) ) { - err("`tsource` and `fsource` arguments to `merge` should be of same type, found " + - ASRUtils::get_type_code(tsource_type) + ", " + - ASRUtils::get_type_code(fsource_type), loc); - } - if( !ASRUtils::is_logical(*mask_type) ) { - err("`mask` argument to `merge` should be of logical type, found " + - ASRUtils::get_type_code(mask_type), loc); - } - - return ASR::make_IntrinsicArrayFunction_t(al, loc, - static_cast(ASRUtils::IntrinsicArrayFunctions::Merge), - args.p, args.size(), 0, result_type, nullptr); - } - - static inline ASR::expr_t* instantiate_Merge(Allocator &al, - const Location &loc, SymbolTable *scope, - Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - LCOMPILERS_ASSERT(arg_types.size() == 3); - - // Array inputs should be elementalised in array_op pass already - LCOMPILERS_ASSERT( !ASRUtils::is_array(arg_types[2]) ); - ASR::ttype_t *tsource_type = ASRUtils::duplicate_type(al, arg_types[0]); - ASR::ttype_t *fsource_type = ASRUtils::duplicate_type(al, arg_types[1]); - ASR::ttype_t *mask_type = ASRUtils::duplicate_type(al, arg_types[2]); - if( ASR::is_a(*tsource_type) ) { - ASR::Character_t* tsource_char = ASR::down_cast(tsource_type); - ASR::Character_t* fsource_char = ASR::down_cast(fsource_type); - tsource_char->m_len_expr = nullptr; fsource_char->m_len_expr = nullptr; - tsource_char->m_len = -2; fsource_char->m_len = -2; - } - std::string new_name = "_lcompilers_merge_" + get_type_code(tsource_type); - - declare_basic_variables(new_name); - if (scope->get_symbol(new_name)) { - ASR::symbol_t *s = scope->get_symbol(new_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); - } - - auto tsource_arg = declare("tsource", tsource_type, In); - args.push_back(al, tsource_arg); - auto fsource_arg = declare("fsource", fsource_type, In); - args.push_back(al, fsource_arg); - auto mask_arg = declare("mask", mask_type, In); - args.push_back(al, mask_arg); - // TODO: In case of Character type, set len of ReturnVar to len(tsource) expression - auto result = declare("merge", type_get_past_allocatable(return_type), ReturnVar); - - { - Vec if_body; if_body.reserve(al, 1); - if_body.push_back(al, b.Assignment(result, tsource_arg)); - Vec else_body; else_body.reserve(al, 1); - else_body.push_back(al, b.Assignment(result, fsource_arg)); - body.push_back(al, STMT(ASR::make_If_t(al, loc, mask_arg, - if_body.p, if_body.n, else_body.p, else_body.n))); - } - - ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, new_symbol); - return b.Call(new_symbol, new_args, return_type, nullptr); - } - -} // namespace Merge - -namespace MinVal { - - static inline void verify_args(const ASR::IntrinsicArrayFunction_t& x, - diag::Diagnostics& diagnostics) { - ArrIntrinsic::verify_args(x, diagnostics, IntrinsicArrayFunctions::MinVal, - &ArrIntrinsic::verify_array_int_real); - } - - static inline ASR::expr_t *eval_MinVal(Allocator & /*al*/, - const Location & /*loc*/, ASR::ttype_t *, Vec& /*args*/) { - return nullptr; - } - - static inline ASR::asr_t* create_MinVal(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - return ArrIntrinsic::create_ArrIntrinsic(al, loc, args, err, - IntrinsicArrayFunctions::MinVal); - } - - static inline ASR::expr_t* instantiate_MinVal(Allocator &al, - const Location &loc, SymbolTable *scope, Vec& arg_types, - ASR::ttype_t *return_type, Vec& new_args, - int64_t overload_id) { - return ArrIntrinsic::instantiate_ArrIntrinsic(al, loc, scope, arg_types, - return_type, new_args, overload_id, IntrinsicArrayFunctions::MinVal, - &get_maximum_value_with_given_type, &ASRBuilder::ElementalMin); - } - -} // namespace MinVal +} // namespace MinVal namespace MinLoc { @@ -1437,9 +1511,9 @@ namespace MinLoc { static inline ASR::asr_t* create_MinLoc(Allocator& al, const Location& loc, Vec& args, - const std::function err) { + diag::Diagnostics& diag) { return ArrIntrinsic::create_MaxMinLoc(al, loc, args, - static_cast(IntrinsicArrayFunctions::MinLoc), err); + static_cast(IntrinsicArrayFunctions::MinLoc), diag); } static inline ASR::expr_t *instantiate_MinLoc(Allocator &al, @@ -1466,14 +1540,14 @@ namespace MatMul { } static inline ASR::expr_t *eval_MatMul(Allocator &, - const Location &, ASR::ttype_t *, Vec&) { + const Location &, ASR::ttype_t *, Vec&, diag::Diagnostics&) { // TODO return nullptr; } static inline ASR::asr_t* create_MatMul(Allocator& al, const Location& loc, Vec& args, - const std::function err) { + diag::Diagnostics& diag) { ASR::expr_t *matrix_a = args[0], *matrix_b = args[1]; bool is_type_allocatable = false; if (ASRUtils::is_allocatable(matrix_a) || ASRUtils::is_allocatable(matrix_b)) { @@ -1492,37 +1566,41 @@ namespace MatMul { is_real(*type_b) || is_complex(*type_b); bool matrix_b_logical = is_logical(*type_b); - if (is_complex(*type_a) || is_complex(*type_b) || - matrix_a_logical || matrix_b_logical) { + if (matrix_a_logical || matrix_b_logical) { // TODO - err("The `matmul` intrinsic doesn't handle logical or " - "complex type yet", loc); + append_error(diag, "The `matmul` intrinsic doesn't handle logical type yet", loc); + return nullptr; } if ( !matrix_a_numeric && !matrix_a_logical ) { - err("The argument `matrix_a` in `matmul` must be of type Integer, " + append_error(diag, "The argument `matrix_a` in `matmul` must be of type Integer, " "Real, Complex or Logical", matrix_a->base.loc); + return nullptr; } else if ( matrix_a_numeric ) { if( !matrix_b_numeric ) { - err("The argument `matrix_b` in `matmul` must be of type " + append_error(diag, "The argument `matrix_b` in `matmul` must be of type " "Integer, Real or Complex if first matrix is of numeric " "type", matrix_b->base.loc); + return nullptr; } } else { if( !matrix_b_logical ) { - err("The argument `matrix_b` in `matmul` must be of type Logical" + append_error(diag, "The argument `matrix_b` in `matmul` must be of type Logical" " if first matrix is of Logical type", matrix_b->base.loc); + return nullptr; } } if ( matrix_a_numeric || matrix_b_numeric ) { - if ( is_real(*type_a) ) { + if ( is_complex(*type_a) ) { + ret_type = extract_type(type_a); + } else if ( is_complex(*type_b) ) { + ret_type = extract_type(type_b); + } else if ( is_real(*type_a) ) { ret_type = extract_type(type_a); } else if ( is_real(*type_b) ) { ret_type = extract_type(type_b); } else { ret_type = extract_type(type_a); } - // TODO: Handle return_type for following types - LCOMPILERS_ASSERT(!is_complex(*type_a) && !is_complex(*type_b)) } LCOMPILERS_ASSERT(!matrix_a_logical && !matrix_b_logical) ASR::dimension_t* matrix_a_dims = nullptr; @@ -1530,11 +1608,13 @@ namespace MatMul { int matrix_a_rank = extract_dimensions_from_ttype(type_a, matrix_a_dims); int matrix_b_rank = extract_dimensions_from_ttype(type_b, matrix_b_dims); if ( matrix_a_rank != 1 && matrix_a_rank != 2 ) { - err("`matmul` accepts arrays of rank 1 or 2 only, provided an array " + append_error(diag, "`matmul` accepts arrays of rank 1 or 2 only, provided an array " "with rank, " + std::to_string(matrix_a_rank), matrix_a->base.loc); + return nullptr; } else if ( matrix_b_rank != 1 && matrix_b_rank != 2 ) { - err("`matmul` accepts arrays of rank 1 or 2 only, provided an array " + append_error(diag, "`matmul` accepts arrays of rank 1 or 2 only, provided an array " "with rank, " + std::to_string(matrix_b_rank), matrix_b->base.loc); + return nullptr; } ASRBuilder b(al, loc); @@ -1547,10 +1627,11 @@ namespace MatMul { int matrix_a_dim_1 = -1, matrix_b_dim_1 = -1; extract_value(matrix_a_dims[0].m_length, matrix_a_dim_1); extract_value(matrix_b_dims[0].m_length, matrix_b_dim_1); - err("The argument `matrix_b` must be of dimension " + append_error(diag, "The argument `matrix_b` must be of dimension " + std::to_string(matrix_a_dim_1) + ", provided an array " "with dimension " + std::to_string(matrix_b_dim_1) + " in `matrix_b('n', m)`", matrix_b->base.loc); + return nullptr; } else { result_dims.push_back(al, b.set_dim(matrix_b_dims[1].m_start, matrix_b_dims[1].m_length)); @@ -1564,10 +1645,11 @@ namespace MatMul { extract_value(matrix_b_dims[0].m_length, matrix_b_dim_1); std::string err_dims = "('n', m)"; if (matrix_b_rank == 1) err_dims = "('n')"; - err("The argument `matrix_b` must be of dimension " + append_error(diag, "The argument `matrix_b` must be of dimension " + std::to_string(matrix_a_dim_2) + ", provided an array " "with dimension " + std::to_string(matrix_b_dim_1) + " in matrix_b" + err_dims, matrix_b->base.loc); + return nullptr; } result_dims.push_back(al, b.set_dim(matrix_a_dims[0].m_start, matrix_a_dims[0].m_length)); @@ -1577,15 +1659,16 @@ namespace MatMul { matrix_b_dims[1].m_length)); } } else { - err("The argument `matrix_b` in `matmul` must be of rank 2, " + append_error(diag, "The argument `matrix_b` in `matmul` must be of rank 2, " "provided an array with rank, " + std::to_string(matrix_b_rank), matrix_b->base.loc); + return nullptr; } ret_type = ASRUtils::duplicate_type(al, ret_type, &result_dims); if (is_type_allocatable) { ret_type = TYPE(ASR::make_Allocatable_t(al, loc, ret_type)); } - ASR::expr_t *value = eval_MatMul(al, loc, ret_type, args); + ASR::expr_t *value = eval_MatMul(al, loc, ret_type, args, diag); return make_IntrinsicArrayFunction_t_util(al, loc, static_cast(IntrinsicArrayFunctions::MatMul), args.p, args.n, overload_id, ret_type, value); @@ -1603,9 +1686,31 @@ namespace MatMul { * [ 3, 4 ] â–¼ */ declare_basic_variables("_lcompilers_matmul"); - fill_func_arg("matrix_a", duplicate_type_with_empty_dims(al, arg_types[0])); - fill_func_arg("matrix_b", duplicate_type_with_empty_dims(al, arg_types[1])); - ASR::expr_t *result = declare("result", return_type, Out); + fill_func_arg("matrix_a_m", duplicate_type_with_empty_dims(al, arg_types[0])); + fill_func_arg("matrix_b_m", duplicate_type_with_empty_dims(al, arg_types[1])); + ASR::ttype_t* return_type_ = return_type; + if( !ASRUtils::is_fixed_size_array(return_type) ) { + bool is_allocatable = ASRUtils::is_allocatable(return_type); + Vec empty_dims; + int result_dims = 2; + if( overload_id == 1 || overload_id == 2 ) { + result_dims = 1; + } + empty_dims.reserve(al, result_dims); + for( int idim = 0; idim < result_dims; idim++ ) { + ASR::dimension_t empty_dim; + empty_dim.loc = loc; + empty_dim.m_start = nullptr; + empty_dim.m_length = nullptr; + empty_dims.push_back(al, empty_dim); + } + return_type_ = ASRUtils::make_Array_t_util(al, loc, + ASRUtils::extract_type(return_type_), empty_dims.p, empty_dims.size()); + if( is_allocatable ) { + return_type_ = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, return_type_)); + } + } + ASR::expr_t *result = declare("result", return_type_, Out); args.push_back(al, result); ASR::expr_t *i = declare("i", int32, Local); ASR::expr_t *j = declare("j", int32, Local); @@ -1616,7 +1721,7 @@ namespace MatMul { extract_dimensions_from_ttype(arg_types[1], matrix_b_dims); ASR::expr_t *res_ref, *a_ref, *b_ref, *a_lbound, *b_lbound; ASR::expr_t *dim_mismatch_check, *a_ubound, *b_ubound; - dim_mismatch_check = iEq(UBound(args[0], 2), UBound(args[1], 1)); + dim_mismatch_check = b.iEq(UBound(args[0], 2), UBound(args[1], 1)); a_lbound = LBound(args[0], 1); a_ubound = UBound(args[0], 1); b_lbound = LBound(args[1], 2); b_ubound = UBound(args[1], 2); std::string assert_msg = "'MatMul' intrinsic dimension mismatch: " @@ -1629,7 +1734,7 @@ namespace MatMul { b_ref = b.ArrayItem_01(args[1], {k, j}); a_ubound = a_lbound; alloc_dims.push_back(al, b.set_dim(LBound(args[1], 2), UBound(args[1], 2))); - dim_mismatch_check = iEq(UBound(args[0], 1), UBound(args[1], 1)); + dim_mismatch_check = b.iEq(UBound(args[0], 1), UBound(args[1], 1)); assert_msg += "`matrix_a(k)` and `matrix_b(k, j)`"; } else if ( overload_id == 2 ) { // r(i) = r(i) + a(i, k) * b(k) @@ -1656,9 +1761,21 @@ namespace MatMul { character(assert_msg.size())))))); ASR::expr_t *mul_value; if (is_real(*expr_type(a_ref)) && is_integer(*expr_type(b_ref))) { - mul_value = b.Mul(a_ref, i2r(b_ref, expr_type(a_ref))); + mul_value = b.Mul(a_ref, b.i2r(b_ref, expr_type(a_ref))); } else if (is_real(*expr_type(b_ref)) && is_integer(*expr_type(a_ref))) { - mul_value = b.Mul(i2r(a_ref, expr_type(b_ref)), b_ref); + mul_value = b.Mul(b.i2r(a_ref, expr_type(b_ref)), b_ref); + } else if (is_real(*expr_type(a_ref)) && is_complex(*expr_type(b_ref))){ + mul_value = b.Mul(EXPR(ASR::make_ComplexConstructor_t(al, loc, a_ref, b.f(0, expr_type(a_ref)), expr_type(b_ref), nullptr)), b_ref); + } else if (is_complex(*expr_type(a_ref)) && is_real(*expr_type(b_ref))){ + mul_value = b.Mul(a_ref, EXPR(ASR::make_ComplexConstructor_t(al, loc, b_ref, b.f(0, expr_type(b_ref)), expr_type(a_ref), nullptr))); + } else if (is_integer(*expr_type(a_ref)) && is_complex(*expr_type(b_ref))) { + int kind = ASRUtils::extract_kind_from_ttype_t(expr_type(b_ref)); + ASR::ttype_t* real_type = TYPE(ASR::make_Real_t(al, loc, kind)); + mul_value = b.Mul(EXPR(ASR::make_ComplexConstructor_t(al, loc, b.i2r(a_ref, real_type), b.f(0, real_type), expr_type(b_ref), nullptr)), b_ref); + } else if (is_complex(*expr_type(a_ref)) && is_integer(*expr_type(b_ref))) { + int kind = ASRUtils::extract_kind_from_ttype_t(expr_type(a_ref)); + ASR::ttype_t* real_type = TYPE(ASR::make_Real_t(al, loc, kind)); + mul_value = b.Mul(a_ref, EXPR(ASR::make_ComplexConstructor_t(al, loc, b.i2r(b_ref, real_type), b.f(0, real_type), expr_type(a_ref), nullptr))); } else { mul_value = b.Mul(a_ref, b_ref); } @@ -1679,6 +1796,1261 @@ namespace MatMul { } // namespace MatMul +namespace Count { + + static inline void verify_args(const ASR::IntrinsicArrayFunction_t &x, + diag::Diagnostics& diagnostics) { + require_impl(x.n_args == 1 || x.n_args == 2 || x.n_args == 3, "`count` intrinsic accepts " + "one, two or three arguments", x.base.base.loc, diagnostics); + require_impl(x.m_args[0], "`mask` argument of `count` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + } + + static inline ASR::expr_t *eval_Count(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t */*return_type*/, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO + return nullptr; + } + + static inline ASR::asr_t* create_Count(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + int64_t id_mask = 0, id_mask_dim = 1; + int64_t overload_id = id_mask; + + ASR::expr_t *mask = args[0], *dim_ = nullptr, *kind = nullptr; + + if (args.size() == 2) { + dim_ = args[1]; + } else if (args.size() == 3) { + dim_ = args[1]; + kind = args[2]; + } + + ASR::ttype_t* mask_type = ASRUtils::expr_type(mask); + if ( dim_ != nullptr ) { + size_t dim_rank = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(dim_)); + if (dim_rank != 0) { + append_error(diag, "dim argument to count must be a scalar and must not be an array", + dim_->base.loc); + return nullptr; + } + + overload_id = id_mask_dim; + } + if ( kind != nullptr) { + size_t kind_rank = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(kind)); + if (kind_rank != 0) { + append_error(diag, "kind argument to count must be a scalar and must not be an array", + kind->base.loc); + return nullptr; + } + } + ASR::expr_t *value = nullptr; + Vec arg_values; arg_values.reserve(al, 2); + ASR::expr_t *mask_value = ASRUtils::expr_value(mask); + arg_values.push_back(al, mask_value); + if( mask ) { + ASR::expr_t *mask_value = ASRUtils::expr_value(mask); + arg_values.push_back(al, mask_value); + } + + ASR::ttype_t* return_type = nullptr; + if( overload_id == id_mask ) { + return_type = int32; + } else if( overload_id == id_mask_dim ) { + Vec dims; + size_t n_dims = ASRUtils::extract_n_dims_from_ttype(mask_type); + dims.reserve(al, (int) n_dims - 1); + for( int i = 0; i < (int) n_dims - 1; i++ ) { + ASR::dimension_t dim; + dim.loc = mask->base.loc; + dim.m_length = nullptr; + dim.m_start = nullptr; + dims.push_back(al, dim); + } + return_type = ASRUtils::make_Array_t_util(al, loc, + int32, dims.p, dims.n, ASR::abiType::Source, + false); + } else if ( kind ) { + int kind_value = ASR::down_cast(ASRUtils::expr_value(kind))->m_n; + return_type = TYPE(ASR::make_Integer_t(al, loc, kind_value)); + } + // value = eval_Count(al, loc, return_type, arg_values, diag); + value = nullptr; + + Vec arr_intrinsic_args; arr_intrinsic_args.reserve(al, 1); + arr_intrinsic_args.push_back(al, mask); + if( dim_ ) { + arr_intrinsic_args.push_back(al, dim_); + } + return make_IntrinsicArrayFunction_t_util(al, loc, + static_cast(IntrinsicArrayFunctions::Count), + arr_intrinsic_args.p, arr_intrinsic_args.n, overload_id, return_type, value); + } + + static inline ASR::expr_t *instantiate_Count(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec &arg_types, ASR::ttype_t *return_type, + Vec &m_args, int64_t overload_id) { + declare_basic_variables("_lcompilers_count"); + fill_func_arg("mask", duplicate_type_with_empty_dims(al, arg_types[0])); + if (overload_id == 0) { + ASR::expr_t *result = declare("result", return_type, ReturnVar); + /* + for array of rank 2, the following code is generated: + result = 0 + do i = lbound(mask, 2), ubound(mask, 2) + do j = lbound(mask, 1), ubound(mask, 1) + if (mask(j, i)) then + result = result + 1 + end if + end do + end do + */ + ASR::dimension_t* array_dims = nullptr; + int array_rank = extract_dimensions_from_ttype(arg_types[0], array_dims); + std::vector do_loop_variables; + for (int i = 0; i < array_rank; i++) { + do_loop_variables.push_back(declare("i_" + std::to_string(i), int32, Local)); + } + body.push_back(al, b.Assignment(result, b.i(0, return_type))); + ASR::stmt_t* do_loop = PassUtils::create_do_loop_helper_count(al, loc, do_loop_variables, args[0], result, array_rank); + body.push_back(al, do_loop); + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, m_args, return_type, nullptr); + } else { + fill_func_arg("dim", duplicate_type_with_empty_dims(al, arg_types[1])); + ASR::expr_t *result = declare("result", return_type, Out); + args.push_back(al, result); + /* + for array of rank 3, the following code is generated: + dim == 2 + do i = 1, ubound(mask, 1) + do k = 1, ubound(mask, 3) + c = 0 + do j = 1, ubound(mask, 2) + if (mask(i, j, k)) then + c = c + 1 + end if + end do + res(i, k) = c + end do + end do + */ + int dim = ASR::down_cast(m_args[1].m_value)->m_n; + ASR::dimension_t* array_dims = nullptr; + int array_rank = extract_dimensions_from_ttype(arg_types[0], array_dims); + std::vector res_idx; + for (int i = 0; i < array_rank - 1; i++) { + res_idx.push_back(declare("i_" + std::to_string(i), int32, Local)); + } + ASR::expr_t* j = declare("j", int32, Local); + ASR::expr_t* c = declare("c", int32, Local); + + std::vector idx; bool dim_found = false; + for (int i = 0; i < array_rank; i++) { + if (i == dim - 1) { + idx.push_back(j); + dim_found = true; + } else { + dim_found ? idx.push_back(res_idx[i-1]): + idx.push_back(res_idx[i]); + } + } + ASR::stmt_t* inner_most_do_loop = b.DoLoop(j, LBound(args[0], dim), UBound(args[0], dim), { + b.If(b.ArrayItem_01(args[0], idx), { + b.Assignment(c, b.Add(c, b.i32(1))), + }, {}) + }); + ASR::stmt_t* do_loop = PassUtils::create_do_loop_helper_count_dim(al, loc, + idx, res_idx, inner_most_do_loop, c, args[0], result, 0, dim); + body.push_back(al, do_loop); + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, nullptr, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, m_args, return_type, nullptr); + } + } + +} // namespace Count + +namespace Pack { + + static inline void verify_args(const ASR::IntrinsicArrayFunction_t &x, + diag::Diagnostics& diagnostics) { + require_impl(x.n_args == 2 || x.n_args == 3, "`pack` intrinsic accepts " + "two or three arguments", x.base.base.loc, diagnostics); + require_impl(x.m_args[0], "`array` argument of `pack` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + require_impl(x.m_args[1], "`mask` argument of `pack` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + } + + template + void populate_vector(std::vector &a, ASR::expr_t *vector_a, int dim) { + if (!vector_a) return; + if (ASR::is_a(*vector_a)) { + vector_a = ASR::down_cast(vector_a)->m_arg; + } + LCOMPILERS_ASSERT(ASR::is_a(*vector_a)); + ASR::ArrayConstant_t *a_const = ASR::down_cast(vector_a); + + for (int i = 0; i < dim; i++) { + ASR::expr_t* arg_a = a_const->m_args[i]; + + if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_n; + } else if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_r; + } else if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_value; + } else { + LCOMPILERS_ASSERT(false); + } + } + } + + template + void populate_vector_complex(std::vector &a, ASR::expr_t *vector_a, int dim) { + if (!vector_a) return; + if (ASR::is_a(*vector_a)) { + vector_a = ASR::down_cast(vector_a)->m_arg; + } + LCOMPILERS_ASSERT(ASR::is_a(*vector_a)); + ASR::ArrayConstant_t *a_const = ASR::down_cast(vector_a); + + for (int i = 0; i < dim; i++) { + ASR::expr_t* arg_a = a_const->m_args[i]; + + if (ASR::is_a(*arg_a)) { + arg_a = ASR::down_cast(arg_a)->m_value; + } + if (arg_a && ASR::is_a(*arg_a)) { + ASR::ComplexConstant_t *c_a = ASR::down_cast(arg_a); + a[i] = {c_a->m_re, c_a->m_im}; + } else { + LCOMPILERS_ASSERT(false); + } + } + } + + template + void evaluate_Pack(std::vector &a, std::vector &b, std::vector &c, std::vector &res) { + int dim_array = a.size(); + int dim_vector = c.size(); + int i = 0; + for (i = 0; i < dim_array; i++) { + if (b[i]) res.push_back(a[i]); + } + + for (i = res.size(); i < dim_vector; i++) { + res.push_back(c[i]); + } + } + + static inline ASR::expr_t *eval_Pack(Allocator & al, + const Location & loc, ASR::ttype_t *return_type, Vec& args, diag::Diagnostics& diag) { + ASR::expr_t *array = args[0], *mask = args[1], *vector = args[2]; + ASR::ttype_t *type_array = ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(expr_type(array))); + ASR::ttype_t *type_vector = ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(expr_type(vector))); + ASR::ttype_t* type_a = ASRUtils::type_get_past_array(type_array); + + int kind = ASRUtils::extract_kind_from_ttype_t(type_a); + int dim_array = ASRUtils::get_fixed_size_of_array(type_array); + int dim_vector = 0; + + bool is_vector_present = false; + if (vector) is_vector_present = true; + if (is_vector_present) dim_vector = ASRUtils::get_fixed_size_of_array(type_vector); + + std::vector b(dim_array); + populate_vector(b, mask, dim_array); + + if (ASRUtils::is_real(*type_a)) { + if (kind == 4) { + std::vector a(dim_array), c(dim_vector), res; + populate_vector(a, array, dim_array); + populate_vector(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_RealConstant_t(al, loc, it, real32))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (kind == 8) { + std::vector a(dim_array), c(dim_vector), res; + populate_vector(a, array, dim_array); + populate_vector(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_RealConstant_t(al, loc, it, real64))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else if (ASRUtils::is_integer(*type_a)) { + if (kind == 4) { + std::vector a(dim_array), c(dim_vector), res; + populate_vector(a, array, dim_array); + populate_vector(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_IntegerConstant_t(al, loc, it, int32))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (kind == 8) { + std::vector a(dim_array), c(dim_vector), res; + populate_vector(a, array, dim_array); + populate_vector(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_IntegerConstant_t(al, loc, it, int64))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else if (ASRUtils::is_logical(*type_a)) { + std::vector a(dim_array), c(dim_vector), res; + populate_vector(a, array, dim_array); + populate_vector(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_LogicalConstant_t(al, loc, it, logical))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (ASRUtils::is_complex(*type_a)) { + if (kind == 4) { + std::vector> a(dim_array), c(dim_vector), res; + populate_vector_complex(a, array, dim_array); + populate_vector_complex(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_ComplexConstant_t(al, loc, it.first, it.second, type_get_past_array(return_type)))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (kind == 8) { + std::vector> a(dim_array), c(dim_vector), res; + populate_vector_complex(a, array, dim_array); + populate_vector_complex(c, vector, dim_vector); + evaluate_Pack(a, b, c, res); + Vec values; values.reserve(al, res.size()); + for (auto it: res) { + values.push_back(al, EXPR(ASR::make_ComplexConstant_t(al, loc, it.first, it.second, type_get_past_array(return_type)))); + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle type " + ASRUtils::get_type_code(type_a) + " yet", loc); + return nullptr; + } + return nullptr; + } + + static inline ASR::asr_t* create_Pack(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + ASR::expr_t *array = args[0], *mask = args[1], *vector = args[2]; + bool is_type_allocatable = false; + bool is_vector_present = false; + if (ASRUtils::is_allocatable(array) || ASRUtils::is_allocatable(mask)) { + // TODO: Use Array type as return type instead of allocatable + // for both Array and Allocatable as input arguments. + is_type_allocatable = true; + } + if (vector) { + is_vector_present = true; + } + + ASR::ttype_t *type_array = expr_type(array); + ASR::ttype_t *type_mask = expr_type(mask); + ASR::ttype_t *type_vector = nullptr; + if (is_vector_present) type_vector = expr_type(vector); + ASR::ttype_t *ret_type = expr_type(array); + bool mask_logical = is_logical(*type_mask); + if( !mask_logical ) { + append_error(diag, "The argument `mask` in `pack` must be of type Logical", mask->base.loc); + return nullptr; + } + ASR::dimension_t* array_dims = nullptr; + ASR::dimension_t* mask_dims = nullptr; + ASR::dimension_t* vector_dims = nullptr; + int array_rank = extract_dimensions_from_ttype(type_array, array_dims); + int mask_rank = extract_dimensions_from_ttype(type_mask, mask_dims); + int array_dim = -1, mask_dim = -1, fixed_size_array = -1; + fixed_size_array = ASRUtils::get_fixed_size_of_array(type_array); + extract_value(array_dims[0].m_length, array_dim); + if (mask_rank == 0) { + Vec mask_expr; mask_expr.reserve(al, fixed_size_array); + for (int i = 0; i < fixed_size_array; i++) { + mask_expr.push_back(al, mask); + } + if (all_args_evaluated(mask_expr)) { + mask = EXPR(ASR::make_ArrayConstant_t(al, mask->base.loc, mask_expr.p, mask_expr.n, + TYPE(ASR::make_Array_t(al, mask->base.loc, logical, array_dims, array_rank, ASR::array_physical_typeType::FixedSizeArray)), + ASR::arraystorageType::ColMajor)); + } else { + mask = EXPR(ASR::make_ArrayConstructor_t(al, mask->base.loc, mask_expr.p, mask_expr.n, + TYPE(ASR::make_Array_t(al, mask->base.loc, logical, array_dims, array_rank, ASR::array_physical_typeType::FixedSizeArray)), + nullptr, ASR::arraystorageType::ColMajor)); + } + type_mask = expr_type(mask); + mask_rank = extract_dimensions_from_ttype(type_mask, mask_dims); + } + int vector_rank = 0; + if (is_vector_present) { + vector_rank = extract_dimensions_from_ttype(type_vector, vector_dims); + } + if (array_rank != mask_rank) { + append_error(diag, "The argument `mask` must be of rank " + std::to_string(array_rank) + + ", provided an array with rank, " + std::to_string(mask_rank), mask->base.loc); + return nullptr; + } + if (!dimension_expr_equal(array_dims[0].m_length, + mask_dims[0].m_length)) { + append_error(diag, "The argument `mask` must be of dimension " + + std::to_string(array_dim) + ", provided an array " + "with dimension " + std::to_string(mask_dim), mask->base.loc); + return nullptr; + } + if (is_vector_present && vector_rank != 1) { + append_error(diag, "`pack` accepts vector of rank 1 only, provided an array " + "with rank, " + std::to_string(vector_rank), vector->base.loc); + return nullptr; + } + + ASRBuilder b(al, loc); + Vec result_dims; result_dims.reserve(al, 1); + int overload_id = 2; + if (is_vector_present) { + result_dims.push_back(al, b.set_dim(vector_dims[0].m_start, vector_dims[0].m_length)); + ret_type = ASRUtils::duplicate_type(al, ret_type, &result_dims); + } else { + Vec args_count; args_count.reserve(al, 1); args_count.push_back(al, mask); + ASR::expr_t* count = EXPR(Count::create_Count(al, loc, args_count, diag)); + result_dims.push_back(al, b.set_dim(array_dims[0].m_start, count)); + ret_type = ASRUtils::duplicate_type(al, ret_type, &result_dims, ASR::array_physical_typeType::DescriptorArray, true); + } + if (is_type_allocatable) { + ret_type = TYPE(ASR::make_Allocatable_t(al, loc, ret_type)); + } + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, array); m_args.push_back(al, mask); + if (is_vector_present) { + m_args.push_back(al, vector); + overload_id = 3; + } + ASR::expr_t *value = nullptr; + if (all_args_evaluated(m_args)) { + value = eval_Pack(al, loc, ret_type, m_args, diag); + } + return make_IntrinsicArrayFunction_t_util(al, loc, + static_cast(IntrinsicArrayFunctions::Pack), + m_args.p, m_args.n, overload_id, ret_type, value); + } + + static inline ASR::expr_t *instantiate_Pack(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec &arg_types, ASR::ttype_t *return_type, + Vec &m_args, int64_t overload_id) { + declare_basic_variables("_lcompilers_pack"); + fill_func_arg("array", duplicate_type_with_empty_dims(al, arg_types[0])); + fill_func_arg("mask", duplicate_type_with_empty_dims(al, arg_types[1])); + if (overload_id == 3) { + fill_func_arg("vector", duplicate_type_with_empty_dims(al, arg_types[2])); + } + ASR::ttype_t* ret_type = return_type; + if (overload_id == 2) { + ret_type = ASRUtils::duplicate_type(al, return_type, nullptr, ASRUtils::extract_physical_type(return_type), true); + LCOMPILERS_ASSERT(ASR::is_a(*ret_type)); + ASR::Array_t *ret_type_array = ASR::down_cast(ret_type); + if (ASR::is_a(*ret_type_array->m_dims[0].m_length)) { + ASR::FunctionCall_t *func_call = ASR::down_cast(ret_type_array->m_dims[0].m_length); + if (ASR::is_a(*func_call->m_args[0].m_value)) { + ASR::ArrayPhysicalCast_t *array_cast = ASR::down_cast(func_call->m_args[0].m_value); + array_cast->m_arg = args[1]; + array_cast->m_old = ASRUtils::extract_physical_type(arg_types[1]); + array_cast->m_type = ASRUtils::duplicate_type_with_empty_dims(al, array_cast->m_type); + + ret_type = TYPE(ASR::make_Array_t(al, loc, ret_type_array->m_type, ret_type_array->m_dims, + ret_type_array->n_dims, ret_type_array->m_physical_type)); + } else { + ret_type = return_type; + } + } else if (ASR::is_a(*ret_type_array->m_dims[0].m_length)) { + ASR::IntrinsicArrayFunction_t *intrinsic_array = ASR::down_cast(ret_type_array->m_dims[0].m_length); + if (ASR::is_a(*intrinsic_array->m_args[0])) { + ASR::ArrayPhysicalCast_t *array_cast = ASR::down_cast(intrinsic_array->m_args[0]); + array_cast->m_arg = args[1]; + array_cast->m_old = ASRUtils::extract_physical_type(arg_types[1]); + array_cast->m_type = ASRUtils::duplicate_type_with_empty_dims(al, array_cast->m_type); + + ret_type = TYPE(ASR::make_Array_t(al, loc, ret_type_array->m_type, ret_type_array->m_dims, + ret_type_array->n_dims, ret_type_array->m_physical_type)); + } else { + ret_type = return_type; + } + } else { + ret_type = return_type; + } + } + ASR::expr_t *result = declare("result", ret_type, Out); + args.push_back(al, result); + /* + For array of rank 2, the following code is generated: + k = lbound(vector, 1) + print *, k + do i = lbound(array, 2), ubound(array, 2) + do j = lbound(array, 1), ubound(array, 1) + ! print *, "mask(", j, ",", i, ") ", mask(j, i) + if (mask(j, i)) then + res(k) = array(j, i) + ! print *, "array(", j, ",", i, ") ", array(j, i) + ! print *, "res(", k, ") ", res(k) + k = k + 1 + end if + end do + end do + + do i = k, ubound(vector, 1) + res(k) = vector(k) + k = k + 1 + end do + */ + ASR::dimension_t* array_dims = nullptr; + int array_rank = extract_dimensions_from_ttype(arg_types[0], array_dims); + std::vector do_loop_variables; + for (int i = 0; i < array_rank; i++) { + do_loop_variables.push_back(declare("i_" + std::to_string(i), int32, Local)); + } + ASR::expr_t *k = declare("k", int32, Local); + body.push_back(al, b.Assignment(k, b.i32(1))); + ASR::stmt_t* do_loop = PassUtils::create_do_loop_helper_pack(al, loc, do_loop_variables, args[0], args[1], result, k, array_rank); + body.push_back(al, do_loop); + + if (overload_id == 3) { + body.push_back(al, b.DoLoop(do_loop_variables[0], k, UBound(args[2], 1), { + b.Assignment(b.ArrayItem_01(result, {k}), b.ArrayItem_01(args[2], {k})), + b.Assignment(k, b.Add(k, b.i32(1))) + })); + } + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, nullptr, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, m_args, return_type, nullptr); + } + +} // namespace Pack + +namespace Unpack { + + static inline void verify_args(const ASR::IntrinsicArrayFunction_t &x, + diag::Diagnostics& diagnostics) { + require_impl(x.n_args == 3, "`unpack` intrinsic accepts " + "three arguments", x.base.base.loc, diagnostics); + require_impl(x.m_args[0], "`vector` argument of `unpack` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + require_impl(x.m_args[1], "`mask` argument of `unpack` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + require_impl(x.m_args[2], "`field` argument of `unpack` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + } + + template + void populate_vector(std::vector &a, ASR::expr_t *vector_a, int dim) { + if (!vector_a) return; + if (ASR::is_a(*vector_a)) { + vector_a = ASR::down_cast(vector_a)->m_arg; + } + LCOMPILERS_ASSERT(ASR::is_a(*vector_a)); + ASR::ArrayConstant_t *a_const = ASR::down_cast(vector_a); + + for (int i = 0; i < dim; i++) { + ASR::expr_t* arg_a = a_const->m_args[i]; + + if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_n; + } else if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_r; + } else if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_value; + } else { + LCOMPILERS_ASSERT(false); + } + } + } + + template + void populate_vector_complex(std::vector &a, ASR::expr_t *vector_a, int dim) { + if (!vector_a) return; + if (ASR::is_a(*vector_a)) { + vector_a = ASR::down_cast(vector_a)->m_arg; + } + LCOMPILERS_ASSERT(ASR::is_a(*vector_a)); + ASR::ArrayConstant_t *a_const = ASR::down_cast(vector_a); + + for (int i = 0; i < dim; i++) { + ASR::expr_t* arg_a = a_const->m_args[i]; + + if (ASR::is_a(*arg_a)) { + arg_a = ASR::down_cast(arg_a)->m_value; + } + if (arg_a && ASR::is_a(*arg_a)) { + ASR::ComplexConstant_t *c_a = ASR::down_cast(arg_a); + a[i] = {c_a->m_re, c_a->m_im}; + } else { + LCOMPILERS_ASSERT(false); + } + } + } + + static inline ASR::expr_t *eval_Unpack(Allocator & al, + const Location & loc, ASR::ttype_t *return_type, Vec& args, diag::Diagnostics& diag) { + ASR::expr_t * vector= args[0], *mask = args[1], *field = args[2]; + ASR::ttype_t *type_vector = ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(expr_type(vector))); + ASR::ttype_t *type_mask = ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(expr_type(mask))); + ASR::ttype_t* type_a = ASRUtils::type_get_past_array(type_vector); + + int kind = ASRUtils::extract_kind_from_ttype_t(type_a); + int dim_mask = ASRUtils::get_fixed_size_of_array(type_mask); + int dim_vector = ASRUtils::get_fixed_size_of_array(type_vector); + + std::vector b(dim_mask); + populate_vector(b, mask, dim_mask); + + if (ASRUtils::is_real(*type_a)) { + if (kind == 4) { + std::vector a(dim_vector), c(dim_mask); + populate_vector(a, vector, dim_vector); + populate_vector(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_RealConstant_t(al, loc, a[i], real32))); + } else { + values.push_back(al, EXPR(ASR::make_RealConstant_t(al, loc, c[i], real32))); + } + } + + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (kind == 8) { + std::vector a(dim_vector), c(dim_mask); + populate_vector(a, vector, dim_vector); + populate_vector(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_RealConstant_t(al, loc, a[i], real64))); + } else { + values.push_back(al, EXPR(ASR::make_RealConstant_t(al, loc, c[i], real64))); + } + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else { + append_error(diag, "The `unpack` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else if (ASRUtils::is_integer(*type_a)) { + if (kind == 4) { + std::vector a(dim_vector), c(dim_mask); + populate_vector(a, vector, dim_vector); + populate_vector(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_IntegerConstant_t(al, loc, a[i], int32))); + } else { + values.push_back(al, EXPR(ASR::make_IntegerConstant_t(al, loc, c[i], int32))); + } + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (kind == 8) { + std::vector a(dim_vector), c(dim_mask); + populate_vector(a, vector, dim_vector); + populate_vector(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_IntegerConstant_t(al, loc, a[i], int64))); + } else { + values.push_back(al, EXPR(ASR::make_IntegerConstant_t(al, loc, c[i], int64))); + } + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else { + append_error(diag, "The `unpack` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else if (ASRUtils::is_logical(*type_a)) { + std::vector a(dim_vector), c(dim_mask); + populate_vector(a, vector, dim_vector); + populate_vector(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_LogicalConstant_t(al, loc, a[i], logical))); + } else { + values.push_back(al, EXPR(ASR::make_LogicalConstant_t(al, loc, c[i], logical))); + } + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + + } else if (ASRUtils::is_complex(*type_a)) { + if (kind == 4) { + std::vector> a(dim_vector), c(dim_mask); + populate_vector_complex(a, vector, dim_vector); + populate_vector_complex(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_ComplexConstant_t(al, loc, a[i].first, a[i].second, type_get_past_array(return_type)))); + } else { + values.push_back(al, EXPR(ASR::make_ComplexConstant_t(al, loc, c[i].first, c[i].second, type_get_past_array(return_type)))); + } + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else if (kind == 8) { + std::vector> a(dim_vector), c(dim_mask); + populate_vector_complex(a, vector, dim_vector); + populate_vector_complex(c, field, dim_mask); + Vec values; values.reserve(al, b.size()); + + for (int i = 0; i < dim_mask; i++) { + if (b[i]) { + values.push_back(al, EXPR(ASR::make_ComplexConstant_t(al, loc, a[i].first, a[i].second, type_get_past_array(return_type)))); + } else { + values.push_back(al, EXPR(ASR::make_ComplexConstant_t(al, loc, c[i].first, c[i].second, type_get_past_array(return_type)))); + } + } + return EXPR(ASR::make_ArrayConstant_t(al, loc, values.p, values.n, return_type, ASR::arraystorageType::ColMajor)); + } else { + append_error(diag, "The `unpack` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else { + append_error(diag, "The `unpack` intrinsic doesn't handle type " + ASRUtils::get_type_code(type_a) + " yet", loc); + } + return nullptr; + } + + static inline ASR::asr_t* create_Unpack(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + ASR::expr_t *vector = args[0], *mask = args[1], *field = args[2]; + bool is_type_allocatable = false; + if (ASRUtils::is_allocatable(field) || ASRUtils::is_allocatable(mask)) { + // TODO: Use Array type as return type instead of allocatable + // for both Array and Allocatable as input arguments. + is_type_allocatable = true; + } + + ASR::ttype_t *type_vector = expr_type(vector); + ASR::ttype_t *type_mask = expr_type(mask); + ASR::ttype_t *type_field = expr_type(field); + ASR::ttype_t *ret_type = type_field; + bool mask_logical = is_logical(*type_mask); + if( !mask_logical ) { + append_error(diag, "The argument `mask` in `unpack` must be of type Logical", mask->base.loc); + return nullptr; + } + ASR::dimension_t* vector_dims = nullptr; + ASR::dimension_t* mask_dims = nullptr; + ASR::dimension_t* field_dims = nullptr; + int vector_rank = extract_dimensions_from_ttype(type_vector, vector_dims); + int mask_rank = extract_dimensions_from_ttype(type_mask, mask_dims); + int field_rank = extract_dimensions_from_ttype(type_field, field_dims); + int vector_dim = -1, mask_dim = -1, field_dim = -1; + extract_value(vector_dims[0].m_length, vector_dim); + extract_value(mask_dims[0].m_length, mask_dim); + extract_value(field_dims[0].m_length, field_dim); + if (vector_rank != 1) { + append_error(diag, "`unpack` accepts vector of rank 1 only, provided an array " + "with rank, " + std::to_string(vector_rank), vector->base.loc); + return nullptr; + } + if (mask_rank == 0) { + append_error(diag, "The argument `mask` in `unpack` must be an array and not a scalar", mask->base.loc); + } + if (field_rank != mask_rank) { + append_error(diag, "The argument `field` must be of rank " + std::to_string(mask_rank) + + ", provided an array with rank, " + std::to_string(field_rank), mask->base.loc); + return nullptr; + } + if (!dimension_expr_equal(field_dims[0].m_length, + mask_dims[0].m_length)) { + append_error(diag, "The argument `field` must be of dimension " + + std::to_string(mask_dim) + ", provided an array " + "with dimension " + std::to_string(field_dim), mask->base.loc); + return nullptr; + } + ASRBuilder b(al, loc); + Vec result_dims; result_dims.reserve(al, 1); + int overload_id = 2; + for (int i = 0; i < mask_rank; i++) { + result_dims.push_back(al, b.set_dim(mask_dims[i].m_start, mask_dims[i].m_length)); + } + ret_type = ASRUtils::duplicate_type(al, ret_type, &result_dims); + if (is_type_allocatable) { + ret_type = TYPE(ASR::make_Allocatable_t(al, loc, ret_type)); + } + Vec m_args; m_args.reserve(al, 3); + m_args.push_back(al, vector); m_args.push_back(al, mask); m_args.push_back(al, field); + ASR::expr_t *value = nullptr; + if (all_args_evaluated(m_args)) { + value = eval_Unpack(al, loc, ret_type, m_args, diag); + } + return make_IntrinsicArrayFunction_t_util(al, loc, + static_cast(IntrinsicArrayFunctions::Unpack), + m_args.p, m_args.n, overload_id, ret_type, value); + } + + static inline ASR::expr_t *instantiate_Unpack(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec &arg_types, ASR::ttype_t *return_type, + Vec &m_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_unpack"); + fill_func_arg("vector", duplicate_type_with_empty_dims(al, arg_types[0])); + fill_func_arg("mask", duplicate_type_with_empty_dims(al, arg_types[1])); + fill_func_arg("field", duplicate_type_with_empty_dims(al, arg_types[2])); + ASR::expr_t *result = declare("result", return_type, Out); + args.push_back(al, result); + /* + For array of rank 2, the following code is generated: + k = lbound(vector, 1) + res = field + do i = lbound(mask, 2), ubound(mask, 2) + do j = lbound(mask, 1), ubound(mask, 1) + print *, "mask(", j, i, ") = ", mask(j, i) + if (mask(j, i)) then + res(j, i) = vector(k) + k = k + 1 + end if + end do + end do + */ + ASR::dimension_t* array_dims = nullptr; + int mask_rank = extract_dimensions_from_ttype(arg_types[1], array_dims); + std::vector do_loop_variables; + for (int i = 0; i < mask_rank; i++) { + do_loop_variables.push_back(declare("i_" + std::to_string(i), int32, Local)); + } + ASR::expr_t *k = declare("k", int32, Local); + body.push_back(al, b.Assignment(k, LBound(args[0], 1))); + body.push_back(al, b.Assignment(result, args[2])); + ASR::stmt_t* do_loop = PassUtils::create_do_loop_helper_unpack(al, loc, do_loop_variables, args[0], args[1], result, k, mask_rank); + body.push_back(al, do_loop); + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, nullptr, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, m_args, return_type, nullptr); + } + +} // namespace Unpack + +namespace DotProduct { + + static inline void verify_args(const ASR::IntrinsicArrayFunction_t &x, + diag::Diagnostics& diagnostics) { + require_impl(x.n_args == 2, "`dot_product` intrinsic accepts exactly" + "two arguments", x.base.base.loc, diagnostics); + require_impl(x.m_args[0], "`vector_a` argument of `dot_product` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + require_impl(x.m_args[1], "`vector_b` argument of `dot_product` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + } + + template + void populate_vector_complex(std::vector &a, std::vector& b, ASR::expr_t *vector_a, ASR::expr_t* vector_b, int dim) { + if (ASR::is_a(*vector_a)) { + vector_a = ASR::down_cast(vector_a)->m_arg; + } + if (ASR::is_a(*vector_b)) { + vector_b = ASR::down_cast(vector_b)->m_arg; + } + LCOMPILERS_ASSERT(ASR::is_a(*vector_a) && ASR::is_a(*vector_b)); + ASR::ArrayConstant_t *a_const = ASR::down_cast(vector_a); + ASR::ArrayConstant_t *b_const = ASR::down_cast(vector_b); + + for (int i = 0; i < dim; i++) { + ASR::expr_t* arg_a = a_const->m_args[i]; + ASR::expr_t* arg_b = b_const->m_args[i]; + + if (ASR::is_a(*arg_a)) { + arg_a = ASR::down_cast(arg_a)->m_value; + } + if (ASR::is_a(*arg_b)) { + arg_b = ASR::down_cast(arg_b)->m_value; + } + + if (arg_a && arg_b && ASR::is_a(*arg_a)) { + ASR::ComplexConstant_t *c_a = ASR::down_cast(arg_a); + ASR::ComplexConstant_t *c_b = ASR::down_cast(arg_b); + a[i] = {c_a->m_re, c_a->m_im}; + b[i] = {c_b->m_re, c_b->m_im}; + } else { + LCOMPILERS_ASSERT(false); + } + } + } + + template + void populate_vector(std::vector &a, std::vector& b, ASR::expr_t *vector_a, ASR::expr_t* vector_b, int dim) { + if (ASR::is_a(*vector_a)) { + vector_a = ASR::down_cast(vector_a)->m_arg; + } + if (ASR::is_a(*vector_b)) { + vector_b = ASR::down_cast(vector_b)->m_arg; + } + LCOMPILERS_ASSERT(ASR::is_a(*vector_a) && ASR::is_a(*vector_b)); + ASR::ArrayConstant_t *a_const = ASR::down_cast(vector_a); + ASR::ArrayConstant_t *b_const = ASR::down_cast(vector_b); + + for (int i = 0; i < dim; i++) { + ASR::expr_t* arg_a = a_const->m_args[i]; + ASR::expr_t* arg_b = b_const->m_args[i]; + + if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_n; + b[i] = ASR::down_cast(arg_b)->m_n; + } else if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_r; + b[i] = ASR::down_cast(arg_b)->m_r; + } else if (ASR::is_a(*arg_a)) { + a[i] = ASR::down_cast(arg_a)->m_value; + b[i] = ASR::down_cast(arg_b)->m_value; + } else { + LCOMPILERS_ASSERT(false); + } + } + } + + static inline ASR::expr_t *eval_DotProduct(Allocator & al, + const Location & loc, ASR::ttype_t *return_type, Vec& args, diag::Diagnostics& diag) { + ASR::expr_t *vector_a = args[0], *vector_b = args[1]; + ASR::ttype_t *type_vector_a = ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_allocatable(expr_type(vector_a))); + ASR::ttype_t* type_a = ASRUtils::type_get_past_array(type_vector_a); + + int kind = ASRUtils::extract_kind_from_ttype_t(type_a); + int dim = ASRUtils::get_fixed_size_of_array(type_vector_a); + + if (ASRUtils::is_real(*type_a)) { + if (kind == 4) { + std::vector a(dim), b(dim); + populate_vector(a, b, vector_a, vector_b, dim); + float result = std::inner_product(a.begin(), a.end(), b.begin(), 0.0f); + return make_ConstantWithType(make_RealConstant_t, result, return_type, loc); + } else if (kind == 8) { + std::vector a(dim), b(dim); + populate_vector(a, b, vector_a, vector_b, dim); + double result = std::inner_product(a.begin(), a.end(), b.begin(), 0.0); + return make_ConstantWithType(make_RealConstant_t, result, return_type, loc); + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else if (ASRUtils::is_integer(*type_a)) { + if (kind == 4) { + std::vector a(dim), b(dim); + populate_vector(a, b, vector_a, vector_b, dim); + int32_t result = std::inner_product(a.begin(), a.end(), b.begin(), 0); + return make_ConstantWithType(make_IntegerConstant_t, result, return_type, loc); + } else if (kind == 8) { + std::vector a(dim), b(dim); + populate_vector(a, b, vector_a, vector_b, dim); + int64_t result = std::inner_product(a.begin(), a.end(), b.begin(), 0); + return make_ConstantWithType(make_IntegerConstant_t, result, return_type, loc); + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else if (ASRUtils::is_logical(*type_a)) { + std::vector a(dim), b(dim); + populate_vector(a, b, vector_a, vector_b, dim); + bool result = false; + for (int i = 0; i < dim; i++) { + result = result || (a[i] && b[i]); + } + return make_ConstantWithType(make_LogicalConstant_t, result, return_type, loc); + } else if (ASRUtils::is_complex(*type_a)) { + if (kind == 4) { + std::vector> a(dim), b(dim); + populate_vector_complex(a, b, vector_a, vector_b, dim); + std::pair result = {0.0f, 0.0f}; + for (int i = 0; i < dim; i++) { + result.first += a[i].first * b[i].first + (a[i].second * b[i].second); + result.second += a[i].first * b[i].second + ((-a[i].second)* b[i].first); + } + return EXPR(make_ComplexConstant_t(al, loc, result.first, result.second, return_type)); + } else if (kind == 8) { + std::vector> a(dim), b(dim); + populate_vector_complex(a, b, vector_a, vector_b, dim); + std::pair result = {0.0, 0.0}; + for (int i = 0; i < dim; i++) { + result.first += a[i].first * b[i].first + (a[i].second * b[i].second); + result.second += a[i].first * b[i].second + ((-a[i].second)* b[i].first); + } + return EXPR(make_ComplexConstant_t(al, loc, result.first, result.second, return_type)); + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle kind " + std::to_string(kind) + " yet", loc); + return nullptr; + } + } else { + append_error(diag, "The `dot_product` intrinsic doesn't handle type " + ASRUtils::get_type_code(type_a) + " yet", loc); + return nullptr; + } + return nullptr; + } + + static inline ASR::asr_t* create_DotProduct(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + ASR::expr_t *matrix_a = args[0], *matrix_b = args[1]; + ASR::ttype_t *type_a = expr_type(matrix_a); + ASR::ttype_t *type_b = expr_type(matrix_b); + ASR::ttype_t *ret_type = nullptr; + bool matrix_a_numeric = is_integer(*type_a) || + is_real(*type_a) || + is_complex(*type_a); + bool matrix_a_logical = is_logical(*type_a); + bool matrix_b_numeric = is_integer(*type_b) || + is_real(*type_b) || + is_complex(*type_b); + bool matrix_b_logical = is_logical(*type_b); + if ( !matrix_a_numeric && !matrix_a_logical ) { + append_error(diag, "The argument `matrix_a` in `dot_product` must be of type Integer, " + "Real, Complex or Logical", matrix_a->base.loc); + return nullptr; + } else if ( matrix_a_numeric ) { + if( !matrix_b_numeric ) { + append_error(diag, "The argument `matrix_b` in `dot_product` must be of type " + "Integer, Real or Complex if first matrix is of numeric " + "type", matrix_b->base.loc); + return nullptr; + } + } else { + if( !matrix_b_logical ) { + append_error(diag, "The argument `matrix_b` in `dot_product` must be of type Logical" + " if first matrix is of Logical type", matrix_b->base.loc); + return nullptr; + } + } + ret_type = extract_type(type_a); + ASR::dimension_t* matrix_a_dims = nullptr; + ASR::dimension_t* matrix_b_dims = nullptr; + int matrix_a_rank = extract_dimensions_from_ttype(type_a, matrix_a_dims); + int matrix_b_rank = extract_dimensions_from_ttype(type_b, matrix_b_dims); + if ( matrix_a_rank != 1) { + append_error(diag, "`dot_product` accepts arrays of rank 1 only, provided an array " + "with rank, " + std::to_string(matrix_a_rank), matrix_a->base.loc); + return nullptr; + } else if ( matrix_b_rank != 1 ) { + append_error(diag, "`dot_product` accepts arrays of rank 1 only, provided an array " + "with rank, " + std::to_string(matrix_b_rank), matrix_b->base.loc); + return nullptr; + } + + int overload_id = 1; + int matrix_a_dim_1 = -1, matrix_b_dim_1 = -1; + if ( !dimension_expr_equal(matrix_a_dims[0].m_length, matrix_b_dims[0].m_length) ) { + append_error(diag, "The argument `matrix_b` must be of dimension " + + std::to_string(matrix_a_dim_1) + ", provided an array " + "with dimension " + std::to_string(matrix_b_dim_1) + + " in `matrix_b('n')`", matrix_b->base.loc); + return nullptr; + } + + ASR::expr_t *value = nullptr; + if (all_args_evaluated(args)) { + value = eval_DotProduct(al, loc, ret_type, args, diag); + } + return make_IntrinsicArrayFunction_t_util(al, loc, + static_cast(IntrinsicArrayFunctions::DotProduct), + args.p, args.n, overload_id, ret_type, value); + } + + static inline ASR::expr_t *instantiate_DotProduct(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec &arg_types, ASR::ttype_t *return_type, + Vec &m_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_dot_product"); + fill_func_arg("matrix_a", duplicate_type_with_empty_dims(al, arg_types[0])); + fill_func_arg("matrix_b", duplicate_type_with_empty_dims(al, arg_types[1])); + ASR::expr_t *result = declare("result", return_type, ReturnVar); + ASR::expr_t *i = declare("i", int32, Local); + /* + res = 0 + do i = LBound(matrix_a, 1), UBound(matrix_a, 1) + res = res + matrix_a(i) * matrix_b(i) + end do + */ + if (is_logical(*return_type)) { + body.push_back(al, b.Assignment(result, ASRUtils::EXPR(ASR::make_LogicalConstant_t(al, loc, false, return_type)))); + body.push_back(al, b.DoLoop(i, LBound(args[0], 1), UBound(args[0], 1), { + b.Assignment(result, b.LogicalOr(result, b.And(b.ArrayItem_01(args[0], {i}), b.ArrayItem_01(args[1], {i})), loc)) + })); + } else if (is_complex(*return_type)) { + body.push_back(al, b.Assignment(result, EXPR(ASR::make_ComplexConstant_t(al, loc, 0.0, 0.0, return_type)))); + + Vec new_args_conjg; new_args_conjg.reserve(al, 1); + ASR::call_arg_t call_arg; call_arg.loc = loc; + call_arg.m_value = b.ArrayItem_01(args[0], {i}); + new_args_conjg.push_back(al, call_arg); + + Vec arg_types_conjg; arg_types_conjg.reserve(al, 1); + arg_types_conjg.push_back(al, return_type); + + ASR::expr_t* func_call_conjg = Conjg::instantiate_Conjg(al, loc, scope, arg_types_conjg, return_type, new_args_conjg, 0); + body.push_back(al, b.DoLoop(i, LBound(args[0], 1), UBound(args[0], 1), { + b.Assignment(result, b.Add(result, EXPR(ASR::make_ComplexBinOp_t(al, loc, func_call_conjg, ASR::binopType::Mul, b.ArrayItem_01(args[1], {i}), return_type, nullptr)))) + }, nullptr)); + } else { + if (is_real(*return_type)) { + body.push_back(al, b.Assignment(result, make_ConstantWithType(make_RealConstant_t, 0.0, return_type, loc))); + } else { + body.push_back(al, b.Assignment(result, make_ConstantWithType(make_IntegerConstant_t, 0, return_type, loc))); + } + body.push_back(al, b.DoLoop(i, LBound(args[0], 1), UBound(args[0], 1), { + b.Assignment(result, b.Add(result, b.Mul(b.ArrayItem_01(args[0], {i}), b.ArrayItem_01(args[1], {i})))) + }, nullptr)); + } + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, m_args, return_type, nullptr); + } + +} // namespace DotProduct + +namespace Transpose { + + static inline void verify_args(const ASR::IntrinsicArrayFunction_t &x, + diag::Diagnostics& diagnostics) { + require_impl(x.n_args == 1, "`transpose` intrinsic accepts exactly" + "one arguments", x.base.base.loc, diagnostics); + require_impl(x.m_args[0], "`matrix` argument of `transpose` intrinsic " + "cannot be nullptr", x.base.base.loc, diagnostics); + } + + static inline ASR::expr_t *eval_Transpose(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t */*return_type*/, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO + return nullptr; + } + + static inline ASR::asr_t* create_Transpose(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + ASR::expr_t *matrix_a = args[0]; + bool is_type_allocatable = false; + if (ASRUtils::is_allocatable(matrix_a)) { + // TODO: Use Array type as return type instead of allocatable + // for both Array and Allocatable as input arguments. + is_type_allocatable = true; + } + ASR::ttype_t *type_a = expr_type(matrix_a); + ASR::ttype_t *ret_type = nullptr; + ret_type = extract_type(type_a); + ASR::dimension_t* matrix_a_dims = nullptr; + int matrix_a_rank = extract_dimensions_from_ttype(type_a, matrix_a_dims); + if ( matrix_a_rank != 2 ) { + append_error(diag, "`transpose` accepts arrays of rank 2 only, provided an array " + "with rank, " + std::to_string(matrix_a_rank), matrix_a->base.loc); + return nullptr; + } + ASRBuilder b(al, loc); + Vec result_dims; result_dims.reserve(al, 2); + int overload_id = 2; + result_dims.push_back(al, b.set_dim(matrix_a_dims[0].m_start, + matrix_a_dims[1].m_length)); + result_dims.push_back(al, b.set_dim(matrix_a_dims[1].m_start, + matrix_a_dims[0].m_length)); + ret_type = ASRUtils::duplicate_type(al, ret_type, &result_dims); + if (is_type_allocatable) { + ret_type = TYPE(ASR::make_Allocatable_t(al, loc, ret_type)); + } + ASR::expr_t *value = nullptr; + if (all_args_evaluated(args)) { + value = eval_Transpose(al, loc, ret_type, args, diag); + } + return make_IntrinsicArrayFunction_t_util(al, loc, + static_cast(IntrinsicArrayFunctions::Transpose), + args.p, args.n, overload_id, ret_type, value); + } + + static inline ASR::expr_t *instantiate_Transpose(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec &arg_types, ASR::ttype_t *return_type, + Vec &m_args, int64_t /*overload_id*/) { + /* + do i = lbound(m,1), ubound(m,1) + do j = lbound(m,2), ubound(m,2) + result(j,i) = m(i,j) + end do + end do + */ + declare_basic_variables("_lcompilers_transpose"); + fill_func_arg("matrix_a_t", duplicate_type_with_empty_dims(al, arg_types[0])); + ASR::ttype_t* return_type_ = return_type; + if( !ASRUtils::is_fixed_size_array(return_type) ) { + bool is_allocatable = ASRUtils::is_allocatable(return_type); + Vec empty_dims; + empty_dims.reserve(al, 2); + for( int idim = 0; idim < 2; idim++ ) { + ASR::dimension_t empty_dim; + empty_dim.loc = loc; + empty_dim.m_start = nullptr; + empty_dim.m_length = nullptr; + empty_dims.push_back(al, empty_dim); + } + return_type_ = ASRUtils::make_Array_t_util(al, loc, + ASRUtils::extract_type(return_type_), empty_dims.p, empty_dims.size()); + if( is_allocatable ) { + return_type_ = ASRUtils::TYPE(ASR::make_Allocatable_t(al, loc, return_type_)); + } + } + ASR::expr_t *result = declare("result", return_type_, Out); + args.push_back(al, result); + ASR::expr_t *i = declare("i", int32, Local); + ASR::expr_t *j = declare("j", int32, Local); + body.push_back(al, b.DoLoop(i, LBound(args[0], 1), UBound(args[0], 1), { + b.DoLoop(j, LBound(args[0], 2), UBound(args[0], 2), { + b.Assignment(b.ArrayItem_01(result, {j, i}), b.ArrayItem_01(args[0], {i, j})) + }, nullptr) + }, nullptr)); + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, nullptr, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, m_args, return_type, nullptr); + } + +} // namespace Transpose + namespace IntrinsicArrayFunctionRegistry { static const std::map(IntrinsicArrayFunctions::Sum), {&Sum::instantiate_Sum, &Sum::verify_args}}, + {static_cast(IntrinsicArrayFunctions::Transpose), + {&Transpose::instantiate_Transpose, &Transpose::verify_args}}, + {static_cast(IntrinsicArrayFunctions::Pack), + {&Pack::instantiate_Pack, &Pack::verify_args}}, + {static_cast(IntrinsicArrayFunctions::Unpack), + {&Unpack::instantiate_Unpack, &Unpack::verify_args}}, + {static_cast(IntrinsicArrayFunctions::Count), + {&Count::instantiate_Count, &Count::verify_args}}, + {static_cast(IntrinsicArrayFunctions::DotProduct), + {&DotProduct::instantiate_DotProduct, &DotProduct::verify_args}}, }; static const std::mapm_value) { *current_expr = x->m_value; return; } Vec new_args; new_args.reserve(al, x->n_args); - // Replace any IntrinsicScalarFunctions in the argument first: + // Replace any IntrinsicElementalFunctions in the argument first: for( size_t i = 0; i < x->n_args; i++ ) { ASR::expr_t** current_expr_copy_ = current_expr; current_expr = &(x->m_args[i]); @@ -64,7 +64,7 @@ class ReplaceIntrinsicFunctions: public ASR::BaseExprReplacer id and look it up. ASRUtils::impl_function instantiate_function = - ASRUtils::IntrinsicScalarFunctionRegistry::get_instantiate_function(x->m_intrinsic_id); + ASRUtils::IntrinsicElementalFunctionRegistry::get_instantiate_function(x->m_intrinsic_id); if( instantiate_function == nullptr ) { return ; } @@ -83,6 +83,7 @@ class ReplaceIntrinsicFunctions: public ASR::BaseExprReplacerm_value; return; } + replace_ttype(x->m_type); Vec new_args; new_args.reserve(al, x->n_args); // Replace any IntrinsicArrayFunctions in the argument first: for( size_t i = 0; i < x->n_args; i++ ) { @@ -122,7 +123,6 @@ class ReplaceIntrinsicFunctions: public ASR::BaseExprReplacerm_arr_intrinsic_id; } } - }; /* @@ -287,8 +287,12 @@ class ReplaceFunctionCallReturningArray: public ASR::BaseExprReplacerm_args[dim_index].m_value; if( !ASRUtils::is_value_constant(ASRUtils::expr_value(dim)) ) { - // Possibly can be replaced by calling "get_result_var_for_runtime_dim" - throw LCompilersException("Runtime values for dim argument is not supported yet."); + result_var_ = PassUtils::create_var(result_counter, + std::string(ASRUtils::symbol_name(x->m_name)) + "_res", + x->base.base.loc, x->m_type, al, current_scope); + if (func2intrinsicid[x_m_name] == ASRUtils::IntrinsicArrayFunctions::Sum) { + PassUtils::allocate_res_var(al, x, new_args, result_var_, pass_result, {0, 0, 1}); + } } else { int constant_dim; if (ASRUtils::extract_value(ASRUtils::expr_value(dim), constant_dim)) { @@ -300,9 +304,53 @@ class ReplaceFunctionCallReturningArray: public ASR::BaseExprReplacer(ASRUtils::symbol_get_past_external(x->m_name)); + ASR::symbol_t* res = pack->m_symtab->resolve_symbol("result"); + if (res) { + ASR::Variable_t* res_var = ASR::down_cast(res); + ASR::Array_t* res_arr = ASR::down_cast(res_var->m_type); + if (ASR::is_a(*res_arr->m_dims[0].m_length)) { + ASRUtils::ExprStmtDuplicator expr_stmt_duplicator(al); + func_call_count = res_arr->m_dims[0].m_length; + func_call_count = expr_stmt_duplicator.duplicate_expr(func_call_count); + + ASR::FunctionCall_t* func_call = ASR::down_cast(func_call_count); + if (ASR::is_a(*func_call->m_args[0].m_value)) { + ASR::ArrayPhysicalCast_t *array_cast = ASR::down_cast(func_call->m_args[0].m_value); + array_cast->m_arg = ASR::down_cast(new_args[1].m_value)->m_arg; + array_cast->m_old = ASRUtils::extract_physical_type(ASRUtils::expr_type(array_cast->m_arg)); + array_cast->m_type = ASRUtils::duplicate_type(al, ASRUtils::expr_type(array_cast->m_arg), nullptr, + ASR::array_physical_typeType::DescriptorArray, true); + + func_call->m_args[0].m_value = ASRUtils::EXPR((ASR::asr_t*) array_cast); + } + } + } + } result_var_ = PassUtils::create_var(result_counter, std::string(ASRUtils::symbol_name(x->m_name)) + "_res", x->base.base.loc, x->m_type, al, current_scope); + if (func_call_count) { + // allocate result array + Vec alloc_args; alloc_args.reserve(al, 1); + Vec alloc_dims; alloc_dims.reserve(al, 2); + ASR::alloc_arg_t alloc_arg; alloc_arg.loc = x->base.base.loc; + ASR::dimension_t dim; dim.loc = x->base.base.loc; + dim.m_start = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x->base.base.loc, 1, + ASRUtils::TYPE(ASR::make_Integer_t(al, x->base.base.loc, 4)))); + dim.m_length = func_call_count; + alloc_dims.push_back(al, dim); + alloc_arg.m_a = result_var_; alloc_arg.m_len_expr = nullptr; + alloc_arg.m_type = nullptr; alloc_arg.m_dims = alloc_dims.p; + alloc_arg.n_dims = alloc_dims.size(); + alloc_args.push_back(al, alloc_arg); + + ASR::stmt_t* allocate_stmt = ASRUtils::STMT(ASR::make_Allocate_t(al, + x->base.base.loc, alloc_args.p, alloc_args.n, nullptr, nullptr, nullptr)); + pass_result.push_back(al, allocate_stmt); + } } else { LCOMPILERS_ASSERT(false); } @@ -314,7 +362,7 @@ class ReplaceFunctionCallReturningArray: public ASR::BaseExprReplacerbase.base.loc, x->m_name, x->m_original_name, new_args.p, - new_args.size(), x->m_dt, nullptr, false))); + new_args.size(), x->m_dt, nullptr, false, false))); *current_expr = new_args.p[new_args.size() - 1].m_value; } diff --git a/src/libasr/pass/intrinsic_function_registry.h b/src/libasr/pass/intrinsic_function_registry.h index 03bceef..21636cf 100644 --- a/src/libasr/pass/intrinsic_function_registry.h +++ b/src/libasr/pass/intrinsic_function_registry.h @@ -1,11 +1,7 @@ #ifndef LFORTRAN_PASS_INTRINSIC_FUNCTION_REGISTRY_H #define LFORTRAN_PASS_INTRINSIC_FUNCTION_REGISTRY_H -#include -#include -#include -#include -#include +#include #include #include @@ -15,3865 +11,721 @@ namespace LCompilers { namespace ASRUtils { -/* -To add a new function implementation, - -1. Create a new namespace like, `Sin`, `LogGamma` in this file. -2. In the above created namespace add `eval_*`, `instantiate_*`, and `create_*`. -3. Then register in the maps present in `IntrinsicScalarFunctionRegistry`. - -You can use helper macros and define your own helper macros to reduce -the code size. -*/ - -enum class IntrinsicScalarFunctions : int64_t { - Sin, - Cos, - Tan, - Asin, - Acos, - Atan, - Sinh, - Cosh, - Tanh, - Atan2, - Gamma, - LogGamma, - Trunc, - Fix, - Abs, - Exp, - Exp2, - Expm1, - FMA, - FlipSign, - Mod, - Trailz, - FloorDiv, - ListIndex, - Partition, - ListReverse, - ListPop, - Reserve, - DictKeys, - DictValues, - SetAdd, - SetRemove, - Max, - Min, - Radix, - Sign, - SignFromValue, - Aint, - Sqrt, - Sngl, - SymbolicSymbol, - SymbolicAdd, - SymbolicSub, - SymbolicMul, - SymbolicDiv, - SymbolicPow, - SymbolicPi, - SymbolicE, - SymbolicInteger, - SymbolicDiff, - SymbolicExpand, - SymbolicSin, - SymbolicCos, - SymbolicLog, - SymbolicExp, - SymbolicAbs, - SymbolicHasSymbolQ, - SymbolicAddQ, - SymbolicMulQ, - SymbolicPowQ, - SymbolicLogQ, - SymbolicSinQ, - SymbolicGetArgument, - // ... -}; - -#define INTRINSIC_NAME_CASE(X) \ - case (static_cast(ASRUtils::IntrinsicScalarFunctions::X)) : { \ - return #X; \ - } - -inline std::string get_intrinsic_name(int x) { - switch (x) { - INTRINSIC_NAME_CASE(Sin) - INTRINSIC_NAME_CASE(Cos) - INTRINSIC_NAME_CASE(Tan) - INTRINSIC_NAME_CASE(Asin) - INTRINSIC_NAME_CASE(Acos) - INTRINSIC_NAME_CASE(Atan) - INTRINSIC_NAME_CASE(Sinh) - INTRINSIC_NAME_CASE(Cosh) - INTRINSIC_NAME_CASE(Tanh) - INTRINSIC_NAME_CASE(Atan2) - INTRINSIC_NAME_CASE(Gamma) - INTRINSIC_NAME_CASE(LogGamma) - INTRINSIC_NAME_CASE(Trunc) - INTRINSIC_NAME_CASE(Fix) - INTRINSIC_NAME_CASE(Abs) - INTRINSIC_NAME_CASE(Exp) - INTRINSIC_NAME_CASE(Exp2) - INTRINSIC_NAME_CASE(Expm1) - INTRINSIC_NAME_CASE(FMA) - INTRINSIC_NAME_CASE(FlipSign) - INTRINSIC_NAME_CASE(FloorDiv) - INTRINSIC_NAME_CASE(Mod) - INTRINSIC_NAME_CASE(Trailz) - INTRINSIC_NAME_CASE(ListIndex) - INTRINSIC_NAME_CASE(Partition) - INTRINSIC_NAME_CASE(ListReverse) - INTRINSIC_NAME_CASE(ListPop) - INTRINSIC_NAME_CASE(Reserve) - INTRINSIC_NAME_CASE(DictKeys) - INTRINSIC_NAME_CASE(DictValues) - INTRINSIC_NAME_CASE(SetAdd) - INTRINSIC_NAME_CASE(SetRemove) - INTRINSIC_NAME_CASE(Max) - INTRINSIC_NAME_CASE(Min) - INTRINSIC_NAME_CASE(Sign) - INTRINSIC_NAME_CASE(SignFromValue) - INTRINSIC_NAME_CASE(Aint) - INTRINSIC_NAME_CASE(Sqrt) - INTRINSIC_NAME_CASE(Sngl) - INTRINSIC_NAME_CASE(SymbolicSymbol) - INTRINSIC_NAME_CASE(SymbolicAdd) - INTRINSIC_NAME_CASE(SymbolicSub) - INTRINSIC_NAME_CASE(SymbolicMul) - INTRINSIC_NAME_CASE(SymbolicDiv) - INTRINSIC_NAME_CASE(SymbolicPow) - INTRINSIC_NAME_CASE(SymbolicPi) - INTRINSIC_NAME_CASE(SymbolicE) - INTRINSIC_NAME_CASE(SymbolicInteger) - INTRINSIC_NAME_CASE(SymbolicDiff) - INTRINSIC_NAME_CASE(SymbolicExpand) - INTRINSIC_NAME_CASE(SymbolicSin) - INTRINSIC_NAME_CASE(SymbolicCos) - INTRINSIC_NAME_CASE(SymbolicLog) - INTRINSIC_NAME_CASE(SymbolicExp) - INTRINSIC_NAME_CASE(SymbolicAbs) - INTRINSIC_NAME_CASE(SymbolicHasSymbolQ) - INTRINSIC_NAME_CASE(SymbolicAddQ) - INTRINSIC_NAME_CASE(SymbolicMulQ) - INTRINSIC_NAME_CASE(SymbolicPowQ) - INTRINSIC_NAME_CASE(SymbolicLogQ) - INTRINSIC_NAME_CASE(SymbolicSinQ) - INTRINSIC_NAME_CASE(SymbolicGetArgument) - default : { - throw LCompilersException("pickle: intrinsic_id not implemented"); - } - } -} - -typedef ASR::expr_t* (*impl_function)( - Allocator&, const Location &, - SymbolTable*, Vec&, ASR::ttype_t *, - Vec&, int64_t); - -typedef ASR::expr_t* (*eval_intrinsic_function)( - Allocator&, const Location &, ASR::ttype_t *, - Vec&); - -typedef ASR::asr_t* (*create_intrinsic_function)( - Allocator&, const Location&, - Vec&, - const std::function); - -typedef void (*verify_function)( - const ASR::IntrinsicScalarFunction_t&, - diag::Diagnostics&); - -typedef ASR::expr_t* (*get_initial_value_func)(Allocator&, ASR::ttype_t*); - - -class ASRBuilder { - private: - - Allocator& al; - // TODO: use the location to point C++ code in `intrinsic_function_registry` - const Location &loc; - - public: - - ASRBuilder(Allocator& al_, const Location& loc_): al(al_), loc(loc_) {} - - #define make_ConstantWithKind(Constructor, TypeConstructor, value, kind, loc) ASRUtils::EXPR( \ - ASR::Constructor( al, loc, value, \ - ASRUtils::TYPE(ASR::TypeConstructor(al, loc, 4)))) \ - - #define make_ConstantWithType(Constructor, value, type, loc) ASRUtils::EXPR( \ - ASR::Constructor(al, loc, value, type)) \ - - #define declare_basic_variables(name) \ - std::string fn_name = scope->get_unique_name(name, false); \ - SymbolTable *fn_symtab = al.make_new(scope); \ - ASRBuilder b(al, loc); \ - Vec args; args.reserve(al, 1); \ - Vec body; body.reserve(al, 1); \ - SetChar dep; dep.reserve(al, 1); - - // Symbols ----------------------------------------------------------------- - ASR::expr_t *Variable(SymbolTable *symtab, std::string var_name, - ASR::ttype_t *type, ASR::intentType intent, - ASR::abiType abi=ASR::abiType::Source, bool a_value_attr=false) { - ASR::symbol_t* sym = ASR::down_cast( - ASR::make_Variable_t(al, loc, symtab, s2c(al, var_name), nullptr, 0, - intent, nullptr, nullptr, ASR::storage_typeType::Default, type, nullptr, abi, - ASR::Public, ASR::presenceType::Required, a_value_attr)); - symtab->add_symbol(s2c(al, var_name), sym); - return ASRUtils::EXPR(ASR::make_Var_t(al, loc, sym)); - } - - #define declare(var_name, type, intent) \ - b.Variable(fn_symtab, var_name, type, ASR::intentType::intent) - - #define fill_func_arg(arg_name, type) { \ - auto arg = declare(arg_name, type, In); \ - args.push_back(al, arg); } - - #define make_ASR_Function_t(name, symtab, dep, args, body, return_var, abi, \ - deftype, bindc_name) \ - ASR::down_cast( ASRUtils::make_Function_t_util(al, loc, \ - symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, \ - return_var, abi, ASR::accessType::Public, \ - deftype, bindc_name, false, false, false, false, \ - false, nullptr, 0, false, false, false)); - - #define make_Function_Without_ReturnVar_t(name, symtab, dep, args, body, \ - abi, deftype, bindc_name) \ - ASR::down_cast( ASRUtils::make_Function_t_util(al, loc, \ - symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, \ - nullptr, abi, ASR::accessType::Public, \ - deftype, bindc_name, false, false, false, false, \ - false, nullptr, 0, false, false, false)); - - // Types ------------------------------------------------------------------- - #define int32 TYPE(ASR::make_Integer_t(al, loc, 4)) - #define int64 TYPE(ASR::make_Integer_t(al, loc, 8)) - #define real32 TYPE(ASR::make_Real_t(al, loc, 4)) - #define real64 TYPE(ASR::make_Real_t(al, loc, 8)) - #define logical TYPE(ASR::make_Logical_t(al, loc, 4)) - #define character(x) TYPE(ASR::make_Character_t(al, loc, 1, x, nullptr)) - #define List(x) TYPE(ASR::make_List_t(al, loc, x)) - - ASR::ttype_t *Tuple(std::vector tuple_type) { - Vec m_tuple_type; m_tuple_type.reserve(al, 3); - for (auto &x: tuple_type) { - m_tuple_type.push_back(al, x); - } - return TYPE(ASR::make_Tuple_t(al, loc, m_tuple_type.p, m_tuple_type.n)); - } - ASR::ttype_t *Array(std::vector dims, ASR::ttype_t *type) { - Vec m_dims; m_dims.reserve(al, 1); - for (auto &x: dims) { - ASR::dimension_t dim; - dim.loc = loc; - if (x == -1) { - dim.m_start = nullptr; - dim.m_length = nullptr; - } else { - dim.m_start = EXPR(ASR::make_IntegerConstant_t(al, loc, 1, int32)); - dim.m_length = EXPR(ASR::make_IntegerConstant_t(al, loc, x, int32)); - } - m_dims.push_back(al, dim); - } - return make_Array_t_util(al, loc, type, m_dims.p, m_dims.n); - } - - // Expressions ------------------------------------------------------------- - #define i(x, t) EXPR(ASR::make_IntegerConstant_t(al, loc, x, t)) - #define i32(x) EXPR(ASR::make_IntegerConstant_t(al, loc, x, int32)) - #define i32_n(x) EXPR(ASR::make_IntegerUnaryMinus_t(al, loc, i32(abs(x)), \ - int32, i32(x))) - #define i32_neg(x, t) EXPR(ASR::make_IntegerUnaryMinus_t(al, loc, x, t, nullptr)) - - #define f(x, t) EXPR(ASR::make_RealConstant_t(al, loc, x, t)) - #define f32(x) EXPR(ASR::make_RealConstant_t(al, loc, x, real32)) - #define f32_neg(x, t) EXPR(ASR::make_RealUnaryMinus_t(al, loc, x, t, nullptr)) - - #define bool32(x) EXPR(ASR::make_LogicalConstant_t(al, loc, x, logical)) - - #define ListItem(x, pos, type) EXPR(ASR::make_ListItem_t(al, loc, x, pos, \ - type, nullptr)) - #define ListAppend(x, val) STMT(ASR::make_ListAppend_t(al, loc, x, val)) - - #define StringSection(s, start, end) EXPR(ASR::make_StringSection_t(al, loc,\ - s, start, end, nullptr, character(-2), nullptr)) - #define StringItem(x, idx) EXPR(ASR::make_StringItem_t(al, loc, x, idx, \ - character(-2), nullptr)) - #define StringConstant(s, type) EXPR(ASR::make_StringConstant_t(al, loc, \ - s2c(al, s), type)) - #define StringLen(s) EXPR(ASR::make_StringLen_t(al, loc, s, int32, nullptr)) - - // Cast -------------------------------------------------------------------- - #define r2i32(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::RealToInteger, int32, nullptr)) - #define r2i64(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::RealToInteger, int64, nullptr)) - #define i2r32(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::IntegerToReal, real32, nullptr)) - #define i2r64(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::IntegerToReal, real64, nullptr)) - #define i2i(x, t) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::IntegerToInteger, t, nullptr)) - #define i2i64(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::IntegerToInteger, int64, nullptr)) - #define i2i32(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::IntegerToInteger, int32, nullptr)) - #define r2r32(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::RealToReal, real32, nullptr)) - #define r2r64(x) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::RealToReal, real64, nullptr)) - #define r2r(x, t) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::RealToReal, t, nullptr)) - #define i2r(x, t) EXPR(ASR::make_Cast_t(al, loc, x, \ - ASR::cast_kindType::IntegerToReal, t, nullptr)) - - // Binop ------------------------------------------------------------------- - #define iAdd(left, right) EXPR(ASR::make_IntegerBinOp_t(al, loc, left, \ - ASR::binopType::Add, right, int32, nullptr)) - - #define iMul(left, right) EXPR(ASR::make_IntegerBinOp_t(al, loc, left, \ - ASR::binopType::Mul, right, int32, nullptr)) - #define iSub(left, right) EXPR(ASR::make_IntegerBinOp_t(al, loc, left, \ - ASR::binopType::Sub, right, int32, nullptr)) - #define iDiv(left, right) r2i32(EXPR(ASR::make_RealBinOp_t(al, loc, \ - i2r32(left), ASR::binopType::Div, i2r32(right), real32, nullptr))) - #define i64Sub(left, right) EXPR(ASR::make_IntegerBinOp_t(al, loc, left, \ - ASR::binopType::Sub, right, int64, nullptr)) - #define iAdd64(left, right) EXPR(ASR::make_IntegerBinOp_t(al, loc, left, \ - ASR::binopType::Add, right, int64, nullptr)) - #define iDiv64(left, right) r2i64(EXPR(ASR::make_RealBinOp_t(al, loc, \ - i2r32(left), ASR::binopType::Div, i2r32(right), real32, nullptr))) - #define r32Div(left, right) EXPR(ASR::make_RealBinOp_t(al, loc, \ - left, ASR::binopType::Div, right, real32, nullptr)) - #define r64Div(left, right) EXPR(ASR::make_RealBinOp_t(al, loc, \ - left, ASR::binopType::Div, right, real64, nullptr)) - - #define r32Sub(left, right) EXPR(ASR::make_RealBinOp_t(al, loc, left, \ - ASR::binopType::Sub, right, real32, nullptr)) - #define r64Sub(left, right) EXPR(ASR::make_RealBinOp_t(al, loc, left, \ - ASR::binopType::Sub, right, real64, nullptr)) - #define r32Mul(left, right) EXPR(ASR::make_RealBinOp_t(al, loc, left, \ - ASR::binopType::Mul, right, real32, nullptr)) - #define r64Mul(left, right) EXPR(ASR::make_RealBinOp_t(al, loc, left, \ - ASR::binopType::Mul, right, real64, nullptr)) - #define rDiv(left, right) ASRUtils::make_ArrayBroadcast_t_util(al, loc, left, right); \ - EXPR(ASR::make_RealBinOp_t(al, loc, left, \ - ASR::binopType::Div, right, real32, nullptr)) \ - - #define And(x, y) EXPR(ASR::make_LogicalBinOp_t(al, loc, x, \ - ASR::logicalbinopType::And, y, logical, nullptr)) - #define Not(x) EXPR(ASR::make_LogicalNot_t(al, loc, x, logical, nullptr)) - - ASR::expr_t *Add(ASR::expr_t *left, ASR::expr_t *right) { - LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); - ASR::ttype_t *type = expr_type(left); - ASRUtils::make_ArrayBroadcast_t_util(al, loc, left, right); - switch (type->type) { - case ASR::ttypeType::Integer : { - return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, - ASR::binopType::Add, right, type, nullptr)); - break; - } - case ASR::ttypeType::Real : { - return EXPR(ASR::make_RealBinOp_t(al, loc, left, - ASR::binopType::Add, right, type, nullptr)); - break; - } - default: { - LCOMPILERS_ASSERT(false); - return nullptr; - } - } - } - - ASR::expr_t *Mul(ASR::expr_t *left, ASR::expr_t *right) { - LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); - ASR::ttype_t *type = expr_type(left); - ASRUtils::make_ArrayBroadcast_t_util(al, loc, left, right); - switch (type->type) { - case ASR::ttypeType::Integer : { - return EXPR(ASR::make_IntegerBinOp_t(al, loc, left, - ASR::binopType::Mul, right, type, nullptr)); - break; - } - case ASR::ttypeType::Real : { - return EXPR(ASR::make_RealBinOp_t(al, loc, left, - ASR::binopType::Mul, right, type, nullptr)); - break; - } - default: { - LCOMPILERS_ASSERT(false); - return nullptr; - } - } - } - - // Compare ----------------------------------------------------------------- - #define iEq(x, y) EXPR(ASR::make_IntegerCompare_t(al, loc, x, \ - ASR::cmpopType::Eq, y, logical, nullptr)) - #define iNotEq(x, y) EXPR(ASR::make_IntegerCompare_t(al, loc, x, \ - ASR::cmpopType::NotEq, y, logical, nullptr)) - #define iLt(x, y) EXPR(ASR::make_IntegerCompare_t(al, loc, x, \ - ASR::cmpopType::Lt, y, logical, nullptr)) - #define iLtE(x, y) EXPR(ASR::make_IntegerCompare_t(al, loc, x, \ - ASR::cmpopType::LtE, y, logical, nullptr)) - #define iGtE(x, y) EXPR(ASR::make_IntegerCompare_t(al, loc, x, \ - ASR::cmpopType::GtE, y, logical, nullptr)) - #define iGt(x, y) EXPR(ASR::make_IntegerCompare_t(al, loc, x, \ - ASR::cmpopType::Gt, y, logical, nullptr)) - - #define ArraySize_1(x, dim) EXPR(make_ArraySize_t_util(al, loc, x, dim, \ - int32, nullptr)) - #define ArraySize_2(x, dim, t) EXPR(make_ArraySize_t_util(al, loc, x, dim, \ - t, nullptr)) - - #define fGtE(x, y) EXPR(ASR::make_RealCompare_t(al, loc, x, \ - ASR::cmpopType::GtE, y, logical, nullptr)) - #define fLt(x, y) EXPR(ASR::make_RealCompare_t(al, loc, x, \ - ASR::cmpopType::Lt, y, logical, nullptr)) - #define fGt(x, y) EXPR(ASR::make_RealCompare_t(al, loc, x, \ - ASR::cmpopType::Gt, y, logical, nullptr)) - #define fNotEq(x, y) EXPR(ASR::make_RealCompare_t(al, loc, x, \ - ASR::cmpopType::NotEq, y, logical, nullptr)) - - #define sEq(x, y) EXPR(ASR::make_StringCompare_t(al, loc, x, \ - ASR::cmpopType::Eq, y, logical, nullptr)) - #define sNotEq(x, y) EXPR(ASR::make_StringCompare_t(al, loc, x, \ - ASR::cmpopType::NotEq, y, logical, nullptr)) - - ASR::expr_t *Gt(ASR::expr_t *left, ASR::expr_t *right) { - LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); - if (is_real(*expr_type(left))) { - return fGt(left, right); - } else if (is_integer(*expr_type(left))) { - return iGt(left, right); - } else { - LCOMPILERS_ASSERT(false); - return nullptr; - } - } - - ASR::expr_t *Lt(ASR::expr_t *left, ASR::expr_t *right) { - LCOMPILERS_ASSERT(check_equal_type(expr_type(left), expr_type(right))); - if (is_real(*expr_type(left))) { - return fLt(left, right); - } else if (is_integer(*expr_type(left))) { - return iLt(left, right); - } else { - LCOMPILERS_ASSERT(false); - return nullptr; - } - } - - ASR::stmt_t *If(ASR::expr_t *a_test, std::vector if_body, - std::vector else_body) { - Vec m_if_body; m_if_body.reserve(al, 1); - for (auto &x: if_body) m_if_body.push_back(al, x); - - Vec m_else_body; m_else_body.reserve(al, 1); - for (auto &x: else_body) m_else_body.push_back(al, x); - - return STMT(ASR::make_If_t(al, loc, a_test, m_if_body.p, m_if_body.n, - m_else_body.p, m_else_body.n)); - } - - ASR::stmt_t *While(ASR::expr_t *a_test, std::vector body) { - Vec m_body; m_body.reserve(al, 1); - for (auto &x: body) m_body.push_back(al, x); - - return STMT(ASR::make_WhileLoop_t(al, loc, nullptr, a_test, - m_body.p, m_body.n)); - } - - ASR::expr_t *TupleConstant(std::vector ele, ASR::ttype_t *type) { - Vec m_ele; m_ele.reserve(al, 3); - for (auto &x: ele) m_ele.push_back(al, x); - return EXPR(ASR::make_TupleConstant_t(al, loc, m_ele.p, m_ele.n, type)); - } - - #define make_Compare(Constructor, left, op, right) ASRUtils::EXPR(ASR::Constructor( \ - al, loc, left, ASR::cmpopType::op, right, \ - ASRUtils::TYPE(ASR::make_Logical_t( \ - al, loc, 4)), nullptr)); \ - - #define create_ElementalBinOp(OpType, BinOpName, OpName, value) case ASR::ttypeType::OpType: { \ - return ASRUtils::EXPR(ASR::BinOpName(al, loc, \ - left, ASR::binopType::OpName, right, \ - ASRUtils::expr_type(left), value)); \ - } \ - - ASR::expr_t* ElementalAdd(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - ASR::ttype_t *left_type = ASRUtils::expr_type(left); - left_type = ASRUtils::type_get_past_pointer(left_type); - switch (left_type->type) { - create_ElementalBinOp(Real, make_RealBinOp_t, Add, value) - create_ElementalBinOp(Integer, make_IntegerBinOp_t, Add, value) - create_ElementalBinOp(Complex, make_ComplexBinOp_t, Add, value) - default: { - throw LCompilersException("Expression type, " + - std::to_string(left_type->type) + - " not yet supported"); - } - } - } - - ASR::expr_t* ElementalSub(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - switch (ASRUtils::expr_type(left)->type) { - create_ElementalBinOp(Real, make_RealBinOp_t, Sub, value) - create_ElementalBinOp(Integer, make_IntegerBinOp_t, Sub, value) - create_ElementalBinOp(Complex, make_ComplexBinOp_t, Sub, value) - default: { - throw LCompilersException("Expression type, " + - std::to_string(expr_type(left)->type) + - " not yet supported"); - } - } - } - - ASR::expr_t* ElementalDiv(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - switch (ASRUtils::expr_type(left)->type) { - create_ElementalBinOp(Real, make_RealBinOp_t, Div, value) - create_ElementalBinOp(Integer, make_IntegerBinOp_t, Div, value) - create_ElementalBinOp(Complex, make_ComplexBinOp_t, Div, value) - default: { - throw LCompilersException("Expression type, " + - std::to_string(expr_type(left)->type) + - " not yet supported"); - } - } - } - - ASR::expr_t* ElementalMul(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - switch (ASRUtils::expr_type(left)->type) { - create_ElementalBinOp(Real, make_RealBinOp_t, Mul, value) - create_ElementalBinOp(Integer, make_IntegerBinOp_t, Mul, value) - create_ElementalBinOp(Complex, make_ComplexBinOp_t, Mul, value) - default: { - throw LCompilersException("Expression type, " + - std::to_string(expr_type(left)->type) + - " not yet supported"); - } - } - } - - ASR::expr_t* ElementalPow(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - switch (ASRUtils::expr_type(left)->type) { - create_ElementalBinOp(Real, make_RealBinOp_t, Pow, value) - create_ElementalBinOp(Integer, make_IntegerBinOp_t, Pow, value) - create_ElementalBinOp(Complex, make_ComplexBinOp_t, Pow, value) - default: { - throw LCompilersException("Expression type, " + - std::to_string(expr_type(left)->type) + - " not yet supported"); - } - } - } - - ASR::expr_t* ElementalMax(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - ASR::expr_t* test_condition = nullptr; - switch (ASRUtils::expr_type(left)->type) { - case ASR::ttypeType::Integer: { - test_condition = make_Compare(make_IntegerCompare_t, left, Gt, right); - break; - } - case ASR::ttypeType::Real: { - test_condition = make_Compare(make_RealCompare_t, left, Gt, right); - break; - } - default: { - throw LCompilersException("Expression type, " + - std::to_string(expr_type(left)->type) + " not yet supported"); - } - } - return ASRUtils::EXPR(ASR::make_IfExp_t(al, loc, test_condition, left, right, ASRUtils::expr_type(left), value)); - } - - ASR::expr_t* ElementalMin(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc, ASR::expr_t* value=nullptr) { - ASR::expr_t* test_condition = nullptr; - switch (ASRUtils::expr_type(left)->type) { - case ASR::ttypeType::Integer: { - test_condition = make_Compare(make_IntegerCompare_t, left, Lt, right); - break; - } - case ASR::ttypeType::Real: { - test_condition = make_Compare(make_RealCompare_t, left, Lt, right); - break; - } - default: { - throw LCompilersException("Expression type, " + - std::to_string(expr_type(left)->type) + " not yet supported"); - } - } - return ASRUtils::EXPR(ASR::make_IfExp_t(al, loc, test_condition, left, right, ASRUtils::expr_type(left), value)); - } - - ASR::expr_t* ElementalOr(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc) { - return ASRUtils::EXPR(ASR::make_LogicalBinOp_t(al, loc, - left, ASR::Or, right, - ASRUtils::TYPE(ASR::make_Logical_t( al, loc, 4)), nullptr)); - } - - ASR::expr_t* Or(ASR::expr_t* left, ASR::expr_t* right, - const Location& loc) { - return ASRUtils::EXPR(ASR::make_LogicalBinOp_t(al, loc, - left, ASR::Or, right, ASRUtils::expr_type(left), - nullptr)); - } - - ASR::expr_t* Call(ASR::symbol_t* s, Vec& args, - ASR::ttype_t* return_type) { - return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - s, s, args.p, args.size(), return_type, nullptr, nullptr)); - } - - ASR::expr_t* Call(ASR::symbol_t* s, Vec& args, - ASR::ttype_t* return_type) { - Vec args_; args_.reserve(al, 2); - visit_expr_list(al, args, args_); - return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - s, s, args_.p, args_.size(), return_type, nullptr, nullptr)); - } - - ASR::expr_t* Call(ASR::symbol_t* s, Vec& args, - ASR::ttype_t* return_type, ASR::expr_t* value) { - return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - s, s, args.p, args.size(), return_type, value, nullptr)); - } - - ASR::expr_t *ArrayItem_01(ASR::expr_t *arr, std::vector idx) { - Vec idx_vars; idx_vars.reserve(al, 1); - for (auto &x: idx) idx_vars.push_back(al, x); - return PassUtils::create_array_ref(arr, idx_vars, al); - } - - #define ArrayItem_02(arr, idx_vars) PassUtils::create_array_ref(arr, \ - idx_vars, al) - - ASR::expr_t *ArrayConstant(std::vector elements, - ASR::ttype_t *base_type, bool cast2descriptor=true) { - // This function only creates array with rank one - // TODO: Support other dimensions - Vec m_eles; m_eles.reserve(al, 1); - for (auto &x: elements) m_eles.push_back(al, x); - - ASR::ttype_t *fixed_size_type = Array({(int64_t) elements.size()}, base_type); - ASR::expr_t *arr_constant = EXPR(ASR::make_ArrayConstant_t(al, loc, - m_eles.p, m_eles.n, fixed_size_type, ASR::arraystorageType::ColMajor)); - - if (cast2descriptor) { - return cast_to_descriptor(al, arr_constant); - } else { - return arr_constant; - } - } - - ASR::dimension_t set_dim(ASR::expr_t *start, ASR::expr_t *length) { - ASR::dimension_t dim; - dim.loc = loc; - dim.m_start = start; - dim.m_length = length; - return dim; - } - - // Statements -------------------------------------------------------------- - #define Return() STMT(ASR::make_Return_t(al, loc)) - - ASR::stmt_t *Assignment(ASR::expr_t *lhs, ASR::expr_t *rhs) { - LCOMPILERS_ASSERT(check_equal_type(expr_type(lhs), expr_type(rhs))); - return STMT(ASR::make_Assignment_t(al, loc, lhs, rhs, nullptr)); - } - - template - ASR::stmt_t *Assign_Constant(ASR::expr_t *lhs, T init_value) { - ASR::ttype_t *type = expr_type(lhs); - switch(type->type) { - case ASR::ttypeType::Integer : { - return Assignment(lhs, i(init_value, type)); - } - case ASR::ttypeType::Real : { - return Assignment(lhs, f(init_value, type)); - } - default : { - LCOMPILERS_ASSERT(false); - return nullptr; - } - } - } - - ASR::stmt_t *Allocate(ASR::expr_t *m_a, Vec dims) { - Vec alloc_args; alloc_args.reserve(al, 1); - ASR::alloc_arg_t alloc_arg; - alloc_arg.loc = loc; - alloc_arg.m_a = m_a; - alloc_arg.m_dims = dims.p; - alloc_arg.n_dims = dims.n; - alloc_arg.m_type = nullptr; - alloc_arg.m_len_expr = nullptr; - alloc_args.push_back(al, alloc_arg); - return STMT(ASR::make_Allocate_t(al, loc, alloc_args.p, 1, - nullptr, nullptr, nullptr)); - } - - #define UBound(arr, dim) PassUtils::get_bound(arr, dim, "ubound", al) - #define LBound(arr, dim) PassUtils::get_bound(arr, dim, "lbound", al) - - ASR::stmt_t *DoLoop(ASR::expr_t *m_v, ASR::expr_t *start, ASR::expr_t *end, - std::vector loop_body, ASR::expr_t *step=nullptr) { - ASR::do_loop_head_t head; - head.loc = m_v->base.loc; - head.m_v = m_v; - head.m_start = start; - head.m_end = end; - head.m_increment = step; - Vec body; - body.from_pointer_n_copy(al, &loop_body[0], loop_body.size()); - return STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, body.p, body.n)); - } - - template - ASR::stmt_t* create_do_loop( - const Location& loc, int rank, ASR::expr_t* array, - SymbolTable* scope, Vec& idx_vars, - Vec& doloop_body, LOOP_BODY loop_body) { - PassUtils::create_idx_vars(idx_vars, rank, loc, al, scope, "_i"); - - ASR::stmt_t* doloop = nullptr; - for( int i = (int) idx_vars.size() - 1; i >= 0; i-- ) { - ASR::do_loop_head_t head; - head.m_v = idx_vars[i]; - head.m_start = PassUtils::get_bound(array, i + 1, "lbound", al); - head.m_end = PassUtils::get_bound(array, i + 1, "ubound", al); - head.m_increment = nullptr; - - head.loc = head.m_v->base.loc; - doloop_body.reserve(al, 1); - if( doloop == nullptr ) { - loop_body(); - } else { - doloop_body.push_back(al, doloop); - } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, - head, doloop_body.p, doloop_body.size())); - } - return doloop; - } - - template - ASR::stmt_t* create_do_loop( - const Location& loc, ASR::expr_t* array, - Vec& loop_vars, std::vector& loop_dims, - Vec& doloop_body, LOOP_BODY loop_body) { - - ASR::stmt_t* doloop = nullptr; - for( int i = (int) loop_vars.size() - 1; i >= 0; i-- ) { - ASR::do_loop_head_t head; - head.m_v = loop_vars[i]; - head.m_start = PassUtils::get_bound(array, loop_dims[i], "lbound", al); - head.m_end = PassUtils::get_bound(array, loop_dims[i], "ubound", al); - head.m_increment = nullptr; - - head.loc = head.m_v->base.loc; - doloop_body.reserve(al, 1); - if( doloop == nullptr ) { - loop_body(); - } else { - doloop_body.push_back(al, doloop); - } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, - head, doloop_body.p, doloop_body.size())); - } - return doloop; - } - - template - void generate_reduction_intrinsic_stmts_for_scalar_output(const Location& loc, - ASR::expr_t* array, SymbolTable* fn_scope, - Vec& fn_body, Vec& idx_vars, - Vec& doloop_body, INIT init_stmts, LOOP_BODY loop_body) { - init_stmts(); - int rank = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(array)); - ASR::stmt_t* doloop = create_do_loop(loc, - rank, array, fn_scope, idx_vars, doloop_body, - loop_body); - fn_body.push_back(al, doloop); - } - - template - void generate_reduction_intrinsic_stmts_for_array_output(const Location& loc, - ASR::expr_t* array, ASR::expr_t* dim, SymbolTable* fn_scope, - Vec& fn_body, Vec& idx_vars, - Vec& target_idx_vars, Vec& doloop_body, - INIT init_stmts, LOOP_BODY loop_body) { - init_stmts(); - int n_dims = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(array)); - ASR::stmt_t** else_ = nullptr; - size_t else_n = 0; - idx_vars.reserve(al, n_dims); - PassUtils::create_idx_vars(idx_vars, n_dims, loc, al, fn_scope, "_j"); - for( int i = 1; i <= n_dims; i++ ) { - ASR::expr_t* current_dim = i32(i); - ASR::expr_t* test_expr = make_Compare(make_IntegerCompare_t, dim, - Eq, current_dim); - - Vec loop_vars; - std::vector loop_dims; - loop_dims.reserve(n_dims); - loop_vars.reserve(al, n_dims); - target_idx_vars.reserve(al, n_dims - 1); - for( int j = 1; j <= n_dims; j++ ) { - if( j == i ) { - continue ; - } - target_idx_vars.push_back(al, idx_vars[j - 1]); - loop_dims.push_back(j); - loop_vars.push_back(al, idx_vars[j - 1]); - } - loop_dims.push_back(i); - loop_vars.push_back(al, idx_vars[i - 1]); - - ASR::stmt_t* doloop = create_do_loop(loc, - array, loop_vars, loop_dims, doloop_body, - loop_body); - Vec if_body; - if_body.reserve(al, 1); - if_body.push_back(al, doloop); - ASR::stmt_t* if_ = ASRUtils::STMT(ASR::make_If_t(al, loc, test_expr, - if_body.p, if_body.size(), else_, else_n)); - Vec if_else_if; - if_else_if.reserve(al, 1); - if_else_if.push_back(al, if_); - else_ = if_else_if.p; - else_n = if_else_if.size(); - } - fn_body.push_back(al, else_[0]); - } - - ASR::stmt_t *Print(std::vector items) { - // Used for debugging - Vec x_exprs; - x_exprs.from_pointer_n_copy(al, &items[0], items.size()); - return STMT(ASR::make_Print_t(al, loc, x_exprs.p, x_exprs.n, - nullptr, nullptr)); - } - -}; - -namespace UnaryIntrinsicFunction { - -static inline ASR::expr_t* instantiate_functions(Allocator &al, - const Location &loc, SymbolTable *scope, std::string new_name, - ASR::ttype_t *arg_type, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string c_func_name; - switch (arg_type->type) { - case ASR::ttypeType::Complex : { - if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { - c_func_name = "_lfortran_c" + new_name; - } else { - c_func_name = "_lfortran_z" + new_name; - } - break; - } - default : { - if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { - c_func_name = "_lfortran_s" + new_name; - } else { - c_func_name = "_lfortran_d" + new_name; - } - } - } - new_name = "_lcompilers_" + new_name + "_" + type_to_str_python(arg_type); - - declare_basic_variables(new_name); - if (scope->get_symbol(new_name)) { - ASR::symbol_t *s = scope->get_symbol(new_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var)); - } - fill_func_arg("x", arg_type); - auto result = declare(new_name, ASRUtils::extract_type(return_type), ReturnVar); - - { - SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); - Vec args_1; - { - args_1.reserve(al, 1); - ASR::expr_t *arg = b.Variable(fn_symtab_1, "x", arg_type, - ASR::intentType::In, ASR::abiType::BindC, true); - args_1.push_back(al, arg); - } - - ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, - arg_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); - - SetChar dep_1; dep_1.reserve(al, 1); - Vec body_1; body_1.reserve(al, 1); - ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, - body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); - fn_symtab->add_symbol(c_func_name, s); - dep.push_back(al, s2c(al, c_func_name)); - body.push_back(al, b.Assignment(result, b.Call(s, args, arg_type))); - } - - ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, new_symbol); - return b.Call(new_symbol, new_args, return_type); -} - -static inline ASR::asr_t* create_UnaryFunction(Allocator& al, const Location& loc, - Vec& args, eval_intrinsic_function eval_function, - int64_t intrinsic_id, int64_t overload_id, ASR::ttype_t* type) { - ASR::expr_t *value = nullptr; - ASR::expr_t *arg_value = ASRUtils::expr_value(args[0]); - if (arg_value) { - Vec arg_values; - arg_values.reserve(al, 1); - arg_values.push_back(al, arg_value); - value = eval_function(al, loc, type, arg_values); - } - - return ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, intrinsic_id, - args.p, args.n, overload_id, type, value); -} - -static inline ASR::symbol_t *create_KMP_function(Allocator &al, - const Location &loc, SymbolTable *scope) -{ - /* - * Knuth-Morris-Pratt (KMP) string-matching - * This function takes two parameters: - * the sub-string or pattern string and the target string, - * then returns the position of the first occurrence of the - * string in the pattern. - */ - declare_basic_variables("KMP_string_matching"); - fill_func_arg("target_string", character(-2)); - fill_func_arg("pattern", character(-2)); - - auto result = declare("result", int32, ReturnVar); - auto pi_len = declare("pi_len", int32, Local); - auto i = declare("i", int32, Local); - auto j = declare("j", int32, Local); - auto s_len = declare("s_len", int32, Local); - auto pat_len = declare("pat_len", int32, Local); - auto flag = declare("flag", logical, Local); - auto lps = declare("lps", List(int32), Local); - - body.push_back(al, b.Assignment(s_len, StringLen(args[0]))); - body.push_back(al, b.Assignment(pat_len, StringLen(args[1]))); - body.push_back(al, b.Assignment(result, i32_n(-1))); - body.push_back(al, b.If(iEq(pat_len, i32(0)), { - b.Assignment(result, i32(0)), Return() - }, { - b.If(iEq(s_len, i32(0)), { Return() }, {}) - })); - body.push_back(al, b.Assignment(lps, - EXPR(ASR::make_ListConstant_t(al, loc, nullptr, 0, List(int32))))); - body.push_back(al, b.Assignment(i, i32(0))); - body.push_back(al, b.While(iLtE(i, iSub(pat_len, i32(1))), { - b.Assignment(i, iAdd(i, i32(1))), - ListAppend(lps, i32(0)) - })); - body.push_back(al, b.Assignment(flag, bool32(false))); - body.push_back(al, b.Assignment(i, i32(1))); - body.push_back(al, b.Assignment(pi_len, i32(0))); - body.push_back(al, b.While(iLt(i, pat_len), { - b.If(sEq(StringItem(args[1], iAdd(i, i32(1))), - StringItem(args[1], iAdd(pi_len, i32(1)))), { - b.Assignment(pi_len, iAdd(pi_len, i32(1))), - b.Assignment(ListItem(lps, i, int32), pi_len), - b.Assignment(i, iAdd(i, i32(1))) - }, { - b.If(iNotEq(pi_len, i32(0)), { - b.Assignment(pi_len, ListItem(lps, iSub(pi_len, i32(1)), int32)) - }, { - b.Assignment(i, iAdd(i, i32(1))) - }) - }) - })); - body.push_back(al, b.Assignment(j, i32(0))); - body.push_back(al, b.Assignment(i, i32(0))); - body.push_back(al, b.While(And(iGtE(iSub(s_len, i), - iSub(pat_len, j)), Not(flag)), { - b.If(sEq(StringItem(args[1], iAdd(j, i32(1))), - StringItem(args[0], iAdd(i, i32(1)))), { - b.Assignment(i, iAdd(i, i32(1))), - b.Assignment(j, iAdd(j, i32(1))) - }, {}), - b.If(iEq(j, pat_len), { - b.Assignment(result, iSub(i, j)), - b.Assignment(flag, bool32(true)), - b.Assignment(j, ListItem(lps, iSub(j, i32(1)), int32)) - }, { - b.If(And(iLt(i, s_len), sNotEq(StringItem(args[1], iAdd(j, i32(1))), - StringItem(args[0], iAdd(i, i32(1))))), { - b.If(iNotEq(j, i32(0)), { - b.Assignment(j, ListItem(lps, iSub(j, i32(1)), int32)) - }, { - b.Assignment(i, iAdd(i, i32(1))) - }) - }, {}) - }) - })); - body.push_back(al, Return()); - ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, fn_sym); - return fn_sym; -} - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - const Location& loc = x.base.base.loc; - ASRUtils::require_impl(x.n_args == 1, - "Elemental intrinsics must have only 1 input argument", - loc, diagnostics); - - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t* output_type = x.m_type; - ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, output_type, true), - "The input and output type of elemental intrinsics must exactly match, input type: " + - ASRUtils::get_type_code(input_type) + " output type: " + ASRUtils::get_type_code(output_type), - loc, diagnostics); -} - -} // namespace UnaryIntrinsicFunction - -namespace BinaryIntrinsicFunction { - -static inline ASR::expr_t* instantiate_functions(Allocator &al, - const Location &loc, SymbolTable *scope, std::string new_name, - ASR::ttype_t *arg_type, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string c_func_name; - switch (arg_type->type) { - case ASR::ttypeType::Complex : { - if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { - c_func_name = "_lfortran_c" + new_name; - } else { - c_func_name = "_lfortran_z" + new_name; - } - break; - } - default : { - if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { - c_func_name = "_lfortran_s" + new_name; - } else { - c_func_name = "_lfortran_d" + new_name; - } - } - } - new_name = "_lcompilers_" + new_name + "_" + type_to_str_python(arg_type); - - declare_basic_variables(new_name); - if (scope->get_symbol(new_name)) { - ASR::symbol_t *s = scope->get_symbol(new_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var)); - } - fill_func_arg("x", arg_type); - fill_func_arg("y", arg_type) - auto result = declare(new_name, return_type, ReturnVar); - - { - SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); - Vec args_1; - { - args_1.reserve(al, 2); - ASR::expr_t *arg_1 = b.Variable(fn_symtab_1, "x", arg_type, - ASR::intentType::In, ASR::abiType::BindC, true); - ASR::expr_t *arg_2 = b.Variable(fn_symtab_1, "y", arg_type, - ASR::intentType::In, ASR::abiType::BindC, true); - args_1.push_back(al, arg_1); - args_1.push_back(al, arg_2); - } - - ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, - arg_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); - - SetChar dep_1; dep_1.reserve(al, 1); - Vec body_1; body_1.reserve(al, 1); - ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, - body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); - fn_symtab->add_symbol(c_func_name, s); - dep.push_back(al, s2c(al, c_func_name)); - body.push_back(al, b.Assignment(result, b.Call(s, args, arg_type))); - } - - ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, new_symbol); - return b.Call(new_symbol, new_args, return_type); -} - -static inline ASR::asr_t* create_BinaryFunction(Allocator& al, const Location& loc, - Vec& args, eval_intrinsic_function eval_function, - int64_t intrinsic_id, int64_t overload_id, ASR::ttype_t* type) { - ASR::expr_t *value = nullptr; - ASR::expr_t *arg_value_1 = ASRUtils::expr_value(args[0]); - ASR::expr_t *arg_value_2 = ASRUtils::expr_value(args[1]); - if (arg_value_1 && arg_value_2) { - Vec arg_values; - arg_values.reserve(al, 2); - arg_values.push_back(al, arg_value_1); - arg_values.push_back(al, arg_value_2); - value = eval_function(al, loc, type, arg_values); - } - - return ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, intrinsic_id, - args.p, args.n, overload_id, type, value); -} - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - const Location& loc = x.base.base.loc; - ASRUtils::require_impl(x.n_args == 2, - "Binary intrinsics must have only 2 input arguments", - loc, diagnostics); - - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t* input_type_2 = ASRUtils::expr_type(x.m_args[1]); - ASR::ttype_t* output_type = x.m_type; - ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, input_type_2, true), - "The types of both the arguments of binary intrinsics must exactly match, argument 1 type: " + - ASRUtils::get_type_code(input_type) + " argument 2 type: " + ASRUtils::get_type_code(input_type_2), - loc, diagnostics); - ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, output_type, true), - "The input and output type of elemental intrinsics must exactly match, input type: " + - ASRUtils::get_type_code(input_type) + " output type: " + ASRUtils::get_type_code(output_type), - loc, diagnostics); -} - -} // namespace BinaryIntrinsicFunction - -namespace LogGamma { - -static inline ASR::expr_t *eval_log_gamma(Allocator &al, const Location &loc, - ASR::ttype_t *t, Vec& args) { - double rv = ASR::down_cast(args[0])->m_r; - double val = lgamma(rv); - return make_ConstantWithType(make_RealConstant_t, val, t, loc); -} - -static inline ASR::asr_t* create_LogGamma(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); - - if (args.n != 1) { - err("Intrinsic `log_gamma` accepts exactly one argument", loc); - } else if (!ASRUtils::is_real(*type)) { - err("`x` argument of `log_gamma` must be real", - args[0]->base.loc); - } - - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, - eval_log_gamma, static_cast(IntrinsicScalarFunctions::LogGamma), - 0, type); -} - -static inline ASR::expr_t* instantiate_LogGamma (Allocator &al, - const Location &loc, SymbolTable *scope, Vec& arg_types, - ASR::ttype_t *return_type, Vec& new_args, - int64_t overload_id) { - ASR::ttype_t* arg_type = arg_types[0]; - return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, - "log_gamma", arg_type, return_type, new_args, overload_id); -} - -} // namespace LogGamma - -#define create_trunc_macro(X, stdeval) \ -namespace X { \ - static inline ASR::expr_t *eval_##X(Allocator &al, const Location &loc, \ - ASR::ttype_t *t, Vec& args) { \ - LCOMPILERS_ASSERT(args.size() == 1); \ - double rv = ASR::down_cast(args[0])->m_r; \ - if (ASRUtils::extract_value(args[0], rv)) { \ - double val = std::stdeval(rv); \ - return make_ConstantWithType(make_RealConstant_t, val, t, loc); \ - } \ - return nullptr; \ - } \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function err) { \ - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); \ - if (args.n != 1) { \ - err("Intrinsic `#X` accepts exactly one argument", loc); \ - } else if (!ASRUtils::is_real(*type)) { \ - err("`x` argument of `#X` must be real", \ - args[0]->base.loc); \ - } \ - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, \ - eval_##X, static_cast(IntrinsicScalarFunctions::Trunc), \ - 0, type); \ - } \ - static inline ASR::expr_t* instantiate_##X (Allocator &al, \ - const Location &loc, SymbolTable *scope, Vec& arg_types, \ - ASR::ttype_t *return_type, Vec& new_args, \ - int64_t overload_id) { \ - ASR::ttype_t* arg_type = arg_types[0]; \ - return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, \ - "#X", arg_type, return_type, new_args, overload_id); \ - } \ -} // namespace X - -create_trunc_macro(Trunc, trunc) - -namespace Fix { - static inline ASR::expr_t *eval_Fix(Allocator &al, const Location &loc, - ASR::ttype_t *t, Vec& args) { - LCOMPILERS_ASSERT(args.size() == 1); - double rv = ASR::down_cast(args[0])->m_r; - double val; - if (rv > 0.0) { - val = floor(rv); - } else { - val = ceil(rv); - } - return make_ConstantWithType(make_RealConstant_t, val, t, loc); - } - - static inline ASR::asr_t* create_Fix(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); - if (args.n != 1) { - err("Intrinsic `fix` accepts exactly one argument", loc); - } else if (!ASRUtils::is_real(*type)) { - err("`fix` argument of `fix` must be real", - args[0]->base.loc); - } - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, - eval_Fix, static_cast(IntrinsicScalarFunctions::Fix), - 0, type); - } - - static inline ASR::expr_t* instantiate_Fix (Allocator &al, - const Location &loc, SymbolTable *scope, Vec& arg_types, - ASR::ttype_t *return_type, Vec& new_args, - int64_t overload_id) { - ASR::ttype_t* arg_type = arg_types[0]; - return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, - "fix", arg_type, return_type, new_args, overload_id); - } - -} // namespace Fix - -// `X` is the name of the function in the IntrinsicScalarFunctions enum and -// we use the same name for `create_X` and other places -// `stdeval` is the name of the function in the `std` namespace for compile -// numerical time evaluation -// `lcompilers_name` is the name that we use in the C runtime library -#define create_trig(X, stdeval, lcompilers_name) \ -namespace X { \ - static inline ASR::expr_t *eval_##X(Allocator &al, const Location &loc, \ - ASR::ttype_t *t, Vec& args) { \ - LCOMPILERS_ASSERT(args.size() == 1); \ - double rv = -1; \ - if( ASRUtils::extract_value(args[0], rv) ) { \ - double val = std::stdeval(rv); \ - return make_ConstantWithType(make_RealConstant_t, val, t, loc); \ - } else { \ - std::complex crv; \ - if( ASRUtils::extract_value(args[0], crv) ) { \ - std::complex val = std::stdeval(crv); \ - return ASRUtils::EXPR(ASR::make_ComplexConstant_t( \ - al, loc, val.real(), val.imag(), t)); \ - } \ - } \ - return nullptr; \ - } \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function err) \ - { \ - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); \ - if (args.n != 1) { \ - err("Intrinsic `"#X"` accepts exactly one argument", loc); \ - } else if (!ASRUtils::is_real(*type) && !ASRUtils::is_complex(*type)) { \ - err("`x` argument of `"#X"` must be real or complex", \ - args[0]->base.loc); \ - } \ - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, \ - eval_##X, static_cast(IntrinsicScalarFunctions::X), \ - 0, type); \ - } \ - static inline ASR::expr_t* instantiate_##X (Allocator &al, \ - const Location &loc, SymbolTable *scope, \ - Vec& arg_types, ASR::ttype_t *return_type, \ - Vec& new_args,int64_t overload_id) { \ - ASR::ttype_t* arg_type = arg_types[0]; \ - return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, \ - #lcompilers_name, arg_type, return_type, new_args, overload_id); \ - } \ -} // namespace X - -create_trig(Sin, sin, sin) -create_trig(Cos, cos, cos) -create_trig(Tan, tan, tan) -create_trig(Asin, asin, asin) -create_trig(Acos, acos, acos) -create_trig(Atan, atan, atan) -create_trig(Sinh, sinh, sinh) -create_trig(Cosh, cosh, cosh) -create_trig(Tanh, tanh, tanh) - -namespace Atan2 { - static inline ASR::expr_t *eval_Atan2(Allocator &al, const Location &loc, - ASR::ttype_t *t, Vec& args) { - LCOMPILERS_ASSERT(args.size() == 2); - double rv = -1, rv2 = -1; - if( ASRUtils::extract_value(args[0], rv) && ASRUtils::extract_value(args[1], rv2) ) { - double val = std::atan2(rv,rv2); - return make_ConstantWithType(make_RealConstant_t, val, t, loc); - } - return nullptr; - } - static inline ASR::asr_t* create_Atan2(Allocator& al, const Location& loc, - Vec& args, - const std::function err) - { - ASR::ttype_t *type_1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type_2 = ASRUtils::expr_type(args[1]); - if (!ASRUtils::is_real(*type_1)) { - err("`x` argument of \"atan2\" must be real",args[0]->base.loc); - } else if (!ASRUtils::is_real(*type_2)) { - err("`y` argument of \"atan2\" must be real",args[1]->base.loc); - } - return BinaryIntrinsicFunction::create_BinaryFunction(al, loc, args, - eval_Atan2, static_cast(IntrinsicScalarFunctions::Atan2), - 0, type_1); - } - static inline ASR::expr_t* instantiate_Atan2 (Allocator &al, - const Location &loc, SymbolTable *scope, - Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args,int64_t overload_id) { - ASR::ttype_t* arg_type = arg_types[0]; - return BinaryIntrinsicFunction::instantiate_functions(al, loc, scope, - "atan2", arg_type, return_type, new_args, overload_id); - } -} - -namespace Abs { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - const Location& loc = x.base.base.loc; - ASRUtils::require_impl(x.n_args == 1, - "Elemental intrinsics must have only 1 input argument", - loc, diagnostics); - - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t* output_type = x.m_type; - std::string input_type_str = ASRUtils::get_type_code(input_type); - std::string output_type_str = ASRUtils::get_type_code(output_type); - if( ASR::is_a(*ASRUtils::type_get_past_pointer(input_type)) ) { - ASRUtils::require_impl(ASR::is_a(*output_type), - "Abs intrinsic must return output of real for complex input, found: " + output_type_str, - loc, diagnostics); - int input_kind = ASRUtils::extract_kind_from_ttype_t(input_type); - int output_kind = ASRUtils::extract_kind_from_ttype_t(output_type); - ASRUtils::require_impl(input_kind == output_kind, - "The input and output type of Abs intrinsic must be of same kind, input kind: " + - std::to_string(input_kind) + " output kind: " + std::to_string(output_kind), - loc, diagnostics); - ASR::dimension_t *input_dims, *output_dims; - size_t input_n_dims = ASRUtils::extract_dimensions_from_ttype(input_type, input_dims); - size_t output_n_dims = ASRUtils::extract_dimensions_from_ttype(output_type, output_dims); - ASRUtils::require_impl(ASRUtils::dimensions_equal(input_dims, input_n_dims, output_dims, output_n_dims), - "The dimensions of input and output arguments of Abs intrinsic must be same, input: " + - input_type_str + " output: " + output_type_str, loc, diagnostics); - } else { - ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, output_type, true), - "The input and output type of elemental intrinsics must exactly match, input type: " + - input_type_str + " output type: " + output_type_str, loc, diagnostics); - } - } - - static ASR::expr_t *eval_Abs(Allocator &al, const Location &loc, - ASR::ttype_t *t, Vec &args) { - LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); - ASR::expr_t* arg = args[0]; - if (ASRUtils::is_real(*expr_type(arg))) { - double rv = ASR::down_cast(arg)->m_r; - double val = std::abs(rv); - return make_ConstantWithType(make_RealConstant_t, val, t, loc); - } else if (ASRUtils::is_integer(*expr_type(arg))) { - int64_t rv = ASR::down_cast(arg)->m_n; - int64_t val = std::abs(rv); - return make_ConstantWithType(make_IntegerConstant_t, val, t, loc); - } else if (ASRUtils::is_complex(*expr_type(arg))) { - double re = ASR::down_cast(arg)->m_re; - double im = ASR::down_cast(arg)->m_im; - std::complex x(re, im); - double result = std::abs(x); - return make_ConstantWithType(make_RealConstant_t, result, t, loc); - } else { - return nullptr; - } - } - - static inline ASR::asr_t* create_Abs(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 1) { - err("Intrinsic abs function accepts exactly 1 argument", loc); - } - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); - if (!ASRUtils::is_integer(*type) && !ASRUtils::is_real(*type) - && !ASRUtils::is_complex(*type)) { - err("Argument of the abs function must be Integer, Real or Complex", - args[0]->base.loc); - } - if (is_complex(*type)) { - type = TYPE(ASR::make_Real_t(al, type->base.loc, - ASRUtils::extract_kind_from_ttype_t(type))); - } - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_Abs, - static_cast(IntrinsicScalarFunctions::Abs), 0, type); - } - - static inline ASR::expr_t* instantiate_Abs(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string func_name = "_lcompilers_abs_" + type_to_str_python(arg_types[0]); - declare_basic_variables(func_name); - if (scope->get_symbol(func_name)) { - ASR::symbol_t *s = scope->get_symbol(func_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); - } - fill_func_arg("x", arg_types[0]); - - auto result = declare(func_name, return_type, ReturnVar); - - if (is_integer(*arg_types[0]) || is_real(*arg_types[0])) { - /* - * if (x >= 0) then - * r = x - * else - * r = -x - * end if - */ - ASR::expr_t *test; - ASR::expr_t *negative_x; - if (is_integer(*arg_types[0])) { - ASR::expr_t* zero = make_ConstantWithType(make_IntegerConstant_t, 0, arg_types[0], loc); - test = make_Compare(make_IntegerCompare_t, args[0], GtE, zero); - negative_x = EXPR(ASR::make_IntegerUnaryMinus_t(al, loc, args[0], - arg_types[0], nullptr)); - } else { - ASR::expr_t* zero = make_ConstantWithType(make_RealConstant_t, 0.0, arg_types[0], loc); - test = make_Compare(make_RealCompare_t, args[0], GtE, zero); - negative_x = EXPR(ASR::make_RealUnaryMinus_t(al, loc, args[0], - arg_types[0], nullptr)); - } - - Vec if_body; if_body.reserve(al, 1); - if_body.push_back(al, b.Assignment(result, args[0])); - Vec else_body; else_body.reserve(al, 1); - else_body.push_back(al, b.Assignment(result, negative_x)); - body.push_back(al, STMT(ASR::make_If_t(al, loc, test, - if_body.p, if_body.n, else_body.p, else_body.n))); - } else { - // * Complex type: `r = (real(x)**2 + aimag(x)**2)**0.5` - ASR::ttype_t *real_type = TYPE(ASR::make_Real_t(al, loc, - ASRUtils::extract_kind_from_ttype_t(arg_types[0]))); - ASR::symbol_t *sym_result = ASR::down_cast(result)->m_v; - ASR::Variable_t *r_var = ASR::down_cast(sym_result); - r_var->m_type = return_type = real_type; - ASR::expr_t *aimag_of_x; - { - std::string c_func_name; - if (ASRUtils::extract_kind_from_ttype_t(arg_types[0]) == 4) { - c_func_name = "_lfortran_caimag"; - } else { - c_func_name = "_lfortran_zaimag"; - } - SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); - Vec args_1; - { - args_1.reserve(al, 1); - auto arg = b.Variable(fn_symtab_1, "x", arg_types[0], - ASR::intentType::In, ASR::abiType::BindC, true); - args_1.push_back(al, arg); - } - - auto return_var_1 = b.Variable(fn_symtab_1, c_func_name, real_type, - ASR::intentType::ReturnVar, ASR::abiType::BindC, false); - - SetChar dep_1; dep_1.reserve(al, 1); - Vec body_1; body_1.reserve(al, 1); - ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, - body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); - fn_symtab->add_symbol(c_func_name, s); - dep.push_back(al, s2c(al, c_func_name)); - Vec call_args; - { - call_args.reserve(al, 1); - ASR::call_arg_t arg; - arg.loc = args[0]->base.loc; - arg.m_value = args[0]; - call_args.push_back(al, arg); - } - aimag_of_x = b.Call(s, call_args, real_type); - } - ASR::expr_t *constant_two = make_ConstantWithType(make_RealConstant_t, 2.0, real_type, loc); - ASR::expr_t *constant_point_five = make_ConstantWithType(make_RealConstant_t, 0.5, real_type, loc); - ASR::expr_t *real_of_x = EXPR(ASR::make_Cast_t(al, loc, args[0], - ASR::cast_kindType::ComplexToReal, real_type, nullptr)); - - ASR::expr_t *bin_op_1 = b.ElementalPow(real_of_x, constant_two, loc); - ASR::expr_t *bin_op_2 = b.ElementalPow(aimag_of_x, constant_two, loc); - - bin_op_1 = b.ElementalAdd(bin_op_1, bin_op_2, loc); - - body.push_back(al, b.Assignment(result, - b.ElementalPow(bin_op_1, constant_point_five, loc))); - } - - ASR::symbol_t *f_sym = make_ASR_Function_t(func_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(func_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Abs - -namespace Radix { - - // Helper function to verify arguments - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.m_args[0], "Argument of the `radix` " - "can be a nullptr", x.base.base.loc, diagnostics); - } - - // Function to create an instance of the 'radix' intrinsic function - static inline ASR::asr_t* create_Radix(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if ( args.n != 1 ) { - err("Intrinsic `radix` accepts exactly one argument", loc); - } else if ( !is_real(*expr_type(args[0])) - && !is_integer(*expr_type(args[0])) ) { - err("Argument of the `radix` must be Integer or Real", loc); - } - - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Radix), - args.p, args.n, 0, int32, i32(2)); - } - -} // namespace Radix - -namespace Sign { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, - "ASR Verify: Call to sign must have exactly two arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - ASRUtils::require_impl((is_real(*type1) || is_integer(*type2)), - "ASR Verify: Arguments to sign must be of real or integer type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl((ASRUtils::check_equal_type(type1, type2)), - "ASR Verify: All arguments must be of the same type", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_Sign(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - if (ASRUtils::is_real(*t1)) { - double rv1 = std::abs(ASR::down_cast(args[0])->m_r); - double rv2 = ASR::down_cast(args[1])->m_r; - rv1 = copysign(rv1, rv2); - return make_ConstantWithType(make_RealConstant_t, rv1, t1, loc); - } else { - int64_t iv1 = std::abs(ASR::down_cast(args[0])->m_n); - int64_t iv2 = ASR::down_cast(args[1])->m_n; - if (iv2 < 0) iv1 = -iv1; - return make_ConstantWithType(make_IntegerConstant_t, iv1, t1, loc); - } - } - - static inline ASR::asr_t* create_Sign(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Intrinsic sign function accepts exactly 2 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - if (!ASRUtils::is_integer(*type1) && !ASRUtils::is_real(*type1)) { - err("Argument of the sign function must be Integer or Real", - args[0]->base.loc); - } - if (!ASRUtils::check_equal_type(type1, type2)) { - err("Type mismatch in statement function: " - "the second argument must have the same type " - "and kind as the first argument.", args[1]->base.loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 2); - arg_values.push_back(al, expr_value(args[0])); - arg_values.push_back(al, expr_value(args[1])); - m_value = eval_Sign(al, loc, expr_type(args[0]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Sign), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), m_value); - } - - static inline ASR::expr_t* instantiate_Sign(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_sign_" + type_to_str_python(arg_types[0])); - fill_func_arg("x", arg_types[0]); - fill_func_arg("y", arg_types[0]); - auto result = declare(fn_name, return_type, ReturnVar); - if (is_real(*arg_types[0])) { - Vec args; args.reserve(al, 2); - visit_expr_list(al, new_args, args); - ASR::expr_t* real_copy_sign = ASRUtils::EXPR(ASR::make_RealCopySign_t(al, loc, args[0], args[1], arg_types[0], nullptr)); - return real_copy_sign; - } else { - /* - * r = abs(x) - * if (y < 0) then - * r = -r - * end if - */ - ASR::expr_t *zero = i(0, arg_types[0]); - body.push_back(al, b.If(iGtE(args[0], zero), { - b.Assignment(result, args[0]) - }, /* else */ { - b.Assignment(result, i32_neg(args[0], arg_types[0])) - })); - body.push_back(al, b.If(iLt(args[1], zero), { - b.Assignment(result, i32_neg(result, arg_types[0])) - }, {})); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - } - -} // namespace Sign - -namespace Aint { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args > 0 && x.n_args < 3, - "ASR Verify: Call to aint must have one or two arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type = ASRUtils::expr_type(x.m_args[0]); - ASRUtils::require_impl(ASRUtils::is_real(*type), - "ASR Verify: Arguments to aint must be of real type", - x.base.base.loc, diagnostics); - if (x.n_args == 2) { - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - ASRUtils::require_impl(ASRUtils::is_integer(*type2), - "ASR Verify: Second Argument to aint must be of integer type", - x.base.base.loc, diagnostics); - } - } - - static ASR::expr_t *eval_Aint(Allocator &al, const Location &loc, - ASR::ttype_t* arg_type, Vec &args) { - double rv = ASR::down_cast(expr_value(args[0]))->m_r; - return f(std::trunc(rv), arg_type); - } - - static inline ASR::asr_t* create_Aint( - Allocator& al, const Location& loc, Vec& args, - const std::function err) { - ASR::ttype_t* return_type = expr_type(args[0]); - if (!(args.size() == 1 || args.size() == 2)) { - err("Intrinsic `aint` function accepts exactly 1 or 2 arguments", loc); - } else if (!ASRUtils::is_real(*return_type)) { - err("Argument of the `aint` function must be Real", args[0]->base.loc); - } - Vec m_args; m_args.reserve(al, 1); - m_args.push_back(al, args[0]); - if ( args[1] ) { - int kind = -1; - if (!ASR::is_a(*expr_type(args[1])) || - !extract_value(args[1], kind)) { - err("`kind` argument of the `aint` function must be an " - "scalar Integer constant", args[1]->base.loc); - } - return_type = TYPE(ASR::make_Real_t(al, return_type->base.loc, kind)); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(m_args)) { - m_value = eval_Aint(al, loc, return_type, m_args); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Aint), - m_args.p, m_args.n, 0, return_type, m_value); - } - - static inline ASR::expr_t* instantiate_Aint(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string func_name = "_lcompilers_aint_" + type_to_str_python(arg_types[0]); - std::string fn_name = scope->get_unique_name(func_name); - SymbolTable *fn_symtab = al.make_new(scope); - Vec args; - args.reserve(al, new_args.size()); - ASRBuilder b(al, loc); - Vec body; body.reserve(al, 1); - SetChar dep; dep.reserve(al, 1); - if (scope->get_symbol(fn_name)) { - ASR::symbol_t *s = scope->get_symbol(fn_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); - } - fill_func_arg("a", arg_types[0]); - auto result = declare(fn_name, return_type, ReturnVar); - - // Cast: Real -> Integer -> Real - // TODO: this approach doesn't work for numbers > i64_max - body.push_back(al, b.Assignment(result, i2r(r2i64(args[0]), return_type))); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Aint - -namespace Sqrt { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, - "ASR Verify: Call `sqrt` must have exactly one argument", - x.base.base.loc, diagnostics); - ASR::ttype_t *type = ASRUtils::expr_type(x.m_args[0]); - ASRUtils::require_impl(ASRUtils::is_real(*type) || ASRUtils::is_complex(*type), - "ASR Verify: Arguments to `sqrt` must be of real or complex type", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_Sqrt(Allocator &al, const Location &loc, - ASR::ttype_t* arg_type, Vec &args) { - if (is_real(*arg_type)) { - double val = ASR::down_cast(expr_value(args[0]))->m_r; - return f(std::sqrt(val), arg_type); - } else { - std::complex crv; - if( ASRUtils::extract_value(args[0], crv) ) { - std::complex val = std::sqrt(crv); - return ASRUtils::EXPR(ASR::make_ComplexConstant_t( - al, loc, val.real(), val.imag(), arg_type)); - } else { - return nullptr; - } - } - } - - static inline ASR::asr_t* create_Sqrt(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - ASR::ttype_t* return_type = expr_type(args[0]); - if ( args.n != 1 ) { - err("Intrinsic `sqrt` accepts exactly one argument", loc); - } else if ( !(is_real(*return_type) || is_complex(*return_type)) ) { - err("Argument of the `sqrt` must be Real or Complex", loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - m_value = eval_Sqrt(al, loc, return_type, args); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Sqrt), - args.p, args.n, 0, return_type, m_value); - } - - static inline ASR::expr_t* instantiate_Sqrt(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t overload_id) { - ASR::ttype_t* arg_type = arg_types[0]; - if (is_real(*arg_type)) { - return EXPR(ASR::make_IntrinsicFunctionSqrt_t(al, loc, - new_args[0].m_value, return_type, nullptr)); - } else { - return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, - "sqrt", arg_type, return_type, new_args, overload_id); - } - } - -} // namespace Sqrt - -namespace Sngl { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, - "ASR Verify: Call `sngl` must have exactly one argument", - x.base.base.loc, diagnostics); - ASR::ttype_t *type = ASRUtils::expr_type(x.m_args[0]); - ASRUtils::require_impl(ASRUtils::is_real(*type), - "ASR Verify: Arguments to `sngl` must be of real type", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_Sngl(Allocator &al, const Location &loc, - ASR::ttype_t* arg_type, Vec &args) { - double val = ASR::down_cast(expr_value(args[0]))->m_r; - return f(val, arg_type); - } - - static inline ASR::asr_t* create_Sngl( - Allocator& al, const Location& loc, Vec& args, - const std::function err) { - ASR::ttype_t* return_type = real32; - if ( args.n != 1 ) { - err("Intrinsic `sngl` accepts exactly one argument", loc); - } else if ( !is_real(*expr_type(args[0])) ) { - err("Argument of the `sngl` must be Real", loc); - } - Vec m_args; m_args.reserve(al, 1); - m_args.push_back(al, args[0]); - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(m_args)) { - m_value = eval_Sngl(al, loc, return_type, m_args); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Sngl), - m_args.p, m_args.n, 0, return_type, m_value); - } - - static inline ASR::expr_t* instantiate_Sngl(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string func_name = "_lcompilers_sngl_" + type_to_str_python(arg_types[0]); - std::string fn_name = scope->get_unique_name(func_name); - SymbolTable *fn_symtab = al.make_new(scope); - Vec args; - args.reserve(al, new_args.size()); - ASRBuilder b(al, loc); - Vec body; body.reserve(al, 1); - SetChar dep; dep.reserve(al, 1); - if (scope->get_symbol(fn_name)) { - ASR::symbol_t *s = scope->get_symbol(fn_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); - } - fill_func_arg("a", arg_types[0]); - auto result = declare(fn_name, return_type, ReturnVar); - body.push_back(al, b.Assignment(result, r2r32(args[0]))); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Sngl - -namespace FMA { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 3, - "ASR Verify: Call to FMA must have exactly 3 arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - ASR::ttype_t *type3 = ASRUtils::expr_type(x.m_args[2]); - ASRUtils::require_impl((is_real(*type1) && is_real(*type2) && is_real(*type3)), - "ASR Verify: Arguments to FMA must be of real type", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_FMA(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - double a = ASR::down_cast(args[0])->m_r; - double b = ASR::down_cast(args[1])->m_r; - double c = ASR::down_cast(args[2])->m_r; - return make_ConstantWithType(make_RealConstant_t, a + b*c, t1, loc); - } - - static inline ASR::asr_t* create_FMA(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 3) { - err("Intrinsic FMA function accepts exactly 3 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - ASR::ttype_t *type3 = ASRUtils::expr_type(args[2]); - if (!ASRUtils::is_real(*type1) || !ASRUtils::is_real(*type2) || !ASRUtils::is_real(*type3)) { - err("Argument of the FMA function must be Real", - args[0]->base.loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 3); - arg_values.push_back(al, expr_value(args[0])); - arg_values.push_back(al, expr_value(args[1])); - arg_values.push_back(al, expr_value(args[2])); - m_value = eval_FMA(al, loc, expr_type(args[0]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::FMA), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), m_value); - } - - static inline ASR::expr_t* instantiate_FMA(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_optimization_fma_" + type_to_str_python(arg_types[0])); - fill_func_arg("a", arg_types[0]); - fill_func_arg("b", arg_types[0]); - fill_func_arg("c", arg_types[0]); - auto result = declare(fn_name, return_type, ReturnVar); - /* - * result = a + b*c - */ - - ASR::expr_t *op1 = b.ElementalMul(args[1], args[2], loc); - body.push_back(al, b.Assignment(result, - b.ElementalAdd(args[0], op1, loc))); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace FMA - - -namespace SignFromValue { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, - "ASR Verify: Call to SignFromValue must have exactly 2 arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - bool eq_type = ASRUtils::types_equal(type1, type2); - ASRUtils::require_impl(((is_real(*type1) || is_integer(*type1)) && - (is_real(*type2) || is_integer(*type2)) && eq_type), - "ASR Verify: Arguments to SignFromValue must be of equal type and " - "should be either real or integer", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_SignFromValue(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - if (is_real(*t1)) { - double a = ASR::down_cast(args[0])->m_r; - double b = ASR::down_cast(args[1])->m_r; - a = (b < 0 ? -a : a); - return make_ConstantWithType(make_RealConstant_t, a, t1, loc); - } - int64_t a = ASR::down_cast(args[0])->m_n; - int64_t b = ASR::down_cast(args[1])->m_n; - a = (b < 0 ? -a : a); - return make_ConstantWithType(make_IntegerConstant_t, a, t1, loc); - - } - - static inline ASR::asr_t* create_SignFromValue(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Intrinsic SignFromValue function accepts exactly 2 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - bool eq_type = ASRUtils::types_equal(type1, type2); - if (!((is_real(*type1) || is_integer(*type1)) && - (is_real(*type2) || is_integer(*type2)) && eq_type)) { - err("Argument of the SignFromValue function must be either Real or Integer " - "and must be of equal type", - args[0]->base.loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 2); - arg_values.push_back(al, expr_value(args[0])); - arg_values.push_back(al, expr_value(args[1])); - m_value = eval_SignFromValue(al, loc, expr_type(args[0]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::SignFromValue), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), m_value); - } - - static inline ASR::expr_t* instantiate_SignFromValue(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_optimization_signfromvalue_" + type_to_str_python(arg_types[0])); - fill_func_arg("a", arg_types[0]); - fill_func_arg("b", arg_types[1]); - auto result = declare(fn_name, return_type, ReturnVar); - /* - elemental real(real32) function signfromvaluer32r32(a, b) result(d) - real(real32), intent(in) :: a, b - d = a * asignr32(1.0_real32, b) - end function - */ - if (is_real(*arg_types[0])) { - ASR::expr_t *zero = f(0.0, arg_types[1]); - body.push_back(al, b.If(fLt(args[1], zero), { - b.Assignment(result, f32_neg(args[0], arg_types[0])) - }, { - b.Assignment(result, args[0]) - })); - } else { - ASR::expr_t *zero = i(0, arg_types[1]); - body.push_back(al, b.If(iLt(args[1], zero), { - b.Assignment(result, i32_neg(args[0], arg_types[0])) - }, { - b.Assignment(result, args[0]) - })); - } - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace SignFromValue - - -namespace FlipSign { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, - "ASR Verify: Call to FlipSign must have exactly 2 arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - ASRUtils::require_impl((is_integer(*type1) && is_real(*type2)), - "ASR Verify: Arguments to FlipSign must be of int and real type respectively", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_FlipSign(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - int a = ASR::down_cast(args[0])->m_n; - double b = ASR::down_cast(args[1])->m_r; - if (a % 2 == 1) b = -b; - return make_ConstantWithType(make_RealConstant_t, b, t1, loc); - } - - static inline ASR::asr_t* create_FlipSign(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Intrinsic FlipSign function accepts exactly 2 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - if (!ASRUtils::is_integer(*type1) || !ASRUtils::is_real(*type2)) { - err("Argument of the FlipSign function must be int and real respectively", - args[0]->base.loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 2); - arg_values.push_back(al, expr_value(args[0])); - arg_values.push_back(al, expr_value(args[1])); - m_value = eval_FlipSign(al, loc, expr_type(args[1]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::FlipSign), - args.p, args.n, 0, ASRUtils::expr_type(args[1]), m_value); - } - - static inline ASR::expr_t* instantiate_FlipSign(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_optimization_flipsign_" + type_to_str_python(arg_types[1])); - fill_func_arg("signal", arg_types[0]); - fill_func_arg("variable", arg_types[1]); - auto result = declare(fn_name, return_type, ReturnVar); - /* - real(real32) function flipsigni32r32(signal, variable) - integer(int32), intent(in) :: signal - real(real32), intent(out) :: variable - integer(int32) :: q - q = signal/2 - flipsigni32r32 = variable - if (signal - 2*q == 1 ) flipsigni32r32 = -variable - end subroutine - */ - - ASR::expr_t *two = i(2, arg_types[0]); - ASR::expr_t *q = iDiv(args[0], two); - ASR::expr_t *cond = iSub(args[0], iMul(two, q)); - body.push_back(al, b.If(iEq(cond, i(1, arg_types[0])), { - b.Assignment(result, f32_neg(args[1], arg_types[1])) - }, { - b.Assignment(result, args[1]) - })); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace FlipSign - -namespace FloorDiv { - - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, - "ASR Verify: Call to FloorDiv must have exactly 2 arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - type1 = ASRUtils::type_get_past_const(type1); - type2 = ASRUtils::type_get_past_const(type2); - ASRUtils::require_impl((is_integer(*type1) && is_integer(*type2)) || - (is_unsigned_integer(*type1) && is_unsigned_integer(*type2)) || - (is_real(*type1) && is_real(*type2)) || - (is_logical(*type1) && is_logical(*type2)), - "ASR Verify: Arguments to FloorDiv must be of real, integer, unsigned integer or logical type", - x.base.base.loc, diagnostics); - } - - - static ASR::expr_t *eval_FloorDiv(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - type1 = ASRUtils::type_get_past_const(type1); - type2 = ASRUtils::type_get_past_const(type2); - bool is_real1 = is_real(*type1); - bool is_real2 = is_real(*type2); - bool is_int1 = is_integer(*type1); - bool is_int2 = is_integer(*type2); - bool is_unsigned_int1 = is_unsigned_integer(*type1); - bool is_unsigned_int2 = is_unsigned_integer(*type2); - bool is_logical1 = is_logical(*type1); - bool is_logical2 = is_logical(*type2); - - - if (is_int1 && is_int2) { - int64_t a = ASR::down_cast(args[0])->m_n; - int64_t b = ASR::down_cast(args[1])->m_n; - return make_ConstantWithType(make_IntegerConstant_t, a / b, t1, loc); - } else if (is_unsigned_int1 && is_unsigned_int2) { - int64_t a = ASR::down_cast(args[0])->m_n; - int64_t b = ASR::down_cast(args[1])->m_n; - return make_ConstantWithType(make_UnsignedIntegerConstant_t, a / b, t1, loc); - } else if (is_logical1 && is_logical2) { - bool a = ASR::down_cast(args[0])->m_value; - bool b = ASR::down_cast(args[1])->m_value; - return make_ConstantWithType(make_LogicalConstant_t, a / b, t1, loc); - } else if (is_real1 && is_real2) { - double a = ASR::down_cast(args[0])->m_r; - double b = ASR::down_cast(args[1])->m_r; - double r = a / b; - int64_t result = (int64_t)r; - if ( r >= 0.0 || (double)result == r) { - return make_ConstantWithType(make_RealConstant_t, (double)result, t1, loc); - } - return make_ConstantWithType(make_RealConstant_t, (double)(result - 1), t1, loc); - } - return nullptr; - } - - - - static inline ASR::asr_t* create_FloorDiv(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Intrinsic FloorDiv function accepts exactly 2 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - type1 = ASRUtils::type_get_past_const(type1); - type2 = ASRUtils::type_get_past_const(type2); - if (!((ASRUtils::is_integer(*type1) && ASRUtils::is_integer(*type2)) || - (ASRUtils::is_unsigned_integer(*type1) && ASRUtils::is_unsigned_integer(*type2)) || - (ASRUtils::is_real(*type1) && ASRUtils::is_real(*type2)) || - (ASRUtils::is_logical(*type1) && ASRUtils::is_logical(*type2)))) { - err("Argument of the FloorDiv function must be either Real, Integer, Unsigned Integer or Logical", - args[0]->base.loc); - } - ASR::expr_t *m_value = nullptr; - double compile_time_arg2_val; - if (ASRUtils::extract_value(expr_value(args[1]), compile_time_arg2_val)) { - if (compile_time_arg2_val == 0.0) { - err("Division by 0 is not allowed", args[1]->base.loc); - } - } - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 2); - arg_values.push_back(al, expr_value(args[0])); - arg_values.push_back(al, expr_value(args[1])); - m_value = eval_FloorDiv(al, loc, expr_type(args[1]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::FloorDiv), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), m_value); - } - - static inline ASR::expr_t* instantiate_FloorDiv(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_optimization_floordiv_" + type_to_str_python(arg_types[1])); - fill_func_arg("a", arg_types[0]); - fill_func_arg("b", arg_types[1]); - auto r = declare("r", real64, Local); - auto tmp = declare("tmp", int64, Local); - auto result = declare("result", return_type, ReturnVar); - /* - @overload - def _lpython_floordiv(a: i32, b: i32) -> i32: - r: f64 # f32 rounds things up and gives incorrect tmps - tmp: i64 - result: i32 - r = float(a)/float(b) - tmp = i64(r) - if r < 0.0 and f64(tmp) != r: - tmp = tmp - 1 - result = i32(tmp) - return result - */ - - - ASR::expr_t *op1 = r64Div(CastingUtil::perform_casting(args[0], arg_types[0], real64, al, loc), - CastingUtil::perform_casting(args[1], arg_types[1], real64, al, loc)); - body.push_back(al, b.Assignment(r, op1)); - body.push_back(al, b.Assignment(tmp, r2i64(r))); - body.push_back(al, b.If(And(fLt(r, f(0.0, real64)), fNotEq(i2r64(tmp), r)), { - b.Assignment(tmp, i64Sub(tmp, i(1, int64))) - }, {})); - body.push_back(al, b.Assignment(result, CastingUtil::perform_casting(tmp, int64, return_type, al, loc))); - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace FloorDiv - -namespace Mod { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, - "ASR Verify: Call to Mod must have exactly 2 arguments", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(x.m_args[1]); - ASRUtils::require_impl((is_integer(*type1) && is_integer(*type2)) || - (is_real(*type1) && is_real(*type2)), - "ASR Verify: Arguments to Mod must be of real or integer type", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_Mod(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - bool is_real1 = is_real(*ASRUtils::expr_type(args[0])); - bool is_real2 = is_real(*ASRUtils::expr_type(args[1])); - bool is_int1 = is_integer(*ASRUtils::expr_type(args[0])); - bool is_int2 = is_integer(*ASRUtils::expr_type(args[1])); - - if (is_int1 && is_int2) { - int64_t a = ASR::down_cast(args[0])->m_n; - int64_t b = ASR::down_cast(args[1])->m_n; - return make_ConstantWithType(make_IntegerConstant_t, a % b, t1, loc); - } else if (is_real1 && is_real2) { - double a = ASR::down_cast(args[0])->m_r; - double b = ASR::down_cast(args[1])->m_r; - return make_ConstantWithType(make_RealConstant_t, std::fmod(a, b), t1, loc); - } - return nullptr; - } - - static inline ASR::asr_t* create_Mod(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Intrinsic Mod function accepts exactly 2 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); - if (!((ASRUtils::is_integer(*type1) && ASRUtils::is_integer(*type2)) || - (ASRUtils::is_real(*type1) && ASRUtils::is_real(*type2)))) { - err("Argument of the Mod function must be either Real or Integer", - args[0]->base.loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 2); - arg_values.push_back(al, expr_value(args[0])); - arg_values.push_back(al, expr_value(args[1])); - m_value = eval_Mod(al, loc, expr_type(args[1]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Mod), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), m_value); - } - - static inline ASR::expr_t* instantiate_Mod(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_optimization_mod_" + type_to_str_python(arg_types[1])); - fill_func_arg("a", arg_types[0]); - fill_func_arg("p", arg_types[1]); - auto result = declare(fn_name, return_type, ReturnVar); - /* - function modi32i32(a, p) result(d) - integer(int32), intent(in) :: a, p - integer(int32) :: q - q = a/p - d = a - p*q - end function - */ - - ASR::expr_t *q = nullptr, *op1 = nullptr, *op2 = nullptr; - if (is_real(*arg_types[1])) { - int kind = ASRUtils::extract_kind_from_ttype_t(arg_types[1]); - if (kind == 4) { - q = r2i32(r32Div(args[0], args[1])); - op1 = r32Mul(args[1], i2r32(q)); - op2 = r32Sub(args[0], op1); - } else { - q = r2i64(r64Div(args[0], args[1])); - op1 = r64Mul(args[1], i2r64(q)); - op2 = r64Sub(args[0], op1); - } - } else { - q = iDiv(args[0], args[1]); - op1 = iMul(args[1], q); - op2 = iSub(args[0], op1); - } - body.push_back(al, b.Assignment(result, op2)); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Mod - -namespace Trailz { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, - "ASR Verify: Call to Trailz must have exactly 1 argument", - x.base.base.loc, diagnostics); - ASR::ttype_t *type1 = ASRUtils::expr_type(x.m_args[0]); - ASRUtils::require_impl(is_integer(*type1), - "ASR Verify: Arguments to Trailz must be of integer type", - x.base.base.loc, diagnostics); - } - - static ASR::expr_t *eval_Trailz(Allocator &al, const Location &loc, - ASR::ttype_t* t1, Vec &args) { - int64_t a = ASR::down_cast(args[0])->m_n; - int64_t trailing_zeros = ASRUtils::compute_trailing_zeros(a); - return make_ConstantWithType(make_IntegerConstant_t, trailing_zeros, t1, loc); - } - - static inline ASR::asr_t* create_Trailz(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 1) { - err("Intrinsic Trailz function accepts exactly 1 arguments", loc); - } - ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); - if (!(ASRUtils::is_integer(*type1))) { - err("Argument of the Trailz function must be Integer", - args[0]->base.loc); - } - ASR::expr_t *m_value = nullptr; - if (all_args_evaluated(args)) { - Vec arg_values; arg_values.reserve(al, 1); - arg_values.push_back(al, expr_value(args[0])); - m_value = eval_Trailz(al, loc, expr_type(args[0]), arg_values); - } - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Trailz), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), m_value); - } - - static inline ASR::expr_t* instantiate_Trailz(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - declare_basic_variables("_lcompilers_optimization_trailz_" + type_to_str_python(arg_types[0])); - fill_func_arg("n", arg_types[0]); - auto result = declare(fn_name, arg_types[0], ReturnVar); - // This is not the most efficient way to do this, but it works for now. - /* - function trailz(n) result(result) - integer :: n - integer :: result - result = 0 - if (n == 0) then - result = 32 - else - do while (mod(n,2) == 0) - n = n/2 - result = result + 1 - end do - end if - end function - */ - - body.push_back(al, b.Assignment(result, i(0, arg_types[0]))); - ASR::expr_t *two = i(2, arg_types[0]); - int arg_0_kind = ASRUtils::extract_kind_from_ttype_t(arg_types[0]); - - Vec arg_types_mod; arg_types_mod.reserve(al, 2); - arg_types_mod.push_back(al, arg_types[0]); arg_types_mod.push_back(al, ASRUtils::expr_type(two)); - - Vec new_args_mod; new_args_mod.reserve(al, 2); - ASR::call_arg_t arg1; arg1.loc = loc; arg1.m_value = args[0]; - ASR::call_arg_t arg2; arg2.loc = loc; arg2.m_value = two; - new_args_mod.push_back(al, arg1); new_args_mod.push_back(al, arg2); - - ASR::expr_t* func_call_mod = Mod::instantiate_Mod(al, loc, scope, arg_types_mod, return_type, new_args_mod, 0); - ASR::expr_t *cond = iEq(func_call_mod, i(0, arg_types[0])); - - std::vector while_loop_body; - if (arg_0_kind == 4) { - while_loop_body.push_back(b.Assignment(args[0], iDiv(args[0], two))); - while_loop_body.push_back(b.Assignment(result, iAdd(result, i(1, arg_types[0])))); - } else { - while_loop_body.push_back(b.Assignment(args[0], iDiv64(args[0], two))); - while_loop_body.push_back(b.Assignment(result, iAdd64(result, i(1, arg_types[0])))); - } - - ASR::expr_t* check_zero = iEq(args[0], i(0, arg_types[0])); - std::vector if_body; if_body.push_back(b.Assignment(result, i(32, arg_types[0]))); - std::vector else_body; else_body.push_back(b.While(cond, while_loop_body)); - body.push_back(al, b.If(check_zero, if_body, else_body)); - - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Trailz - -#define create_exp_macro(X, stdeval) \ -namespace X { \ - static inline ASR::expr_t* eval_##X(Allocator &al, const Location &loc, \ - ASR::ttype_t *t, Vec &args) { \ - LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); \ - double rv = -1; \ - if( ASRUtils::extract_value(args[0], rv) ) { \ - double val = std::stdeval(rv); \ - return ASRUtils::EXPR(ASR::make_RealConstant_t(al, loc, val, t)); \ - } \ - return nullptr; \ - } \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function err) { \ - if (args.size() != 1) { \ - err("Intrinsic function `"#X"` accepts exactly 1 argument", loc); \ - } \ - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); \ - if (!ASRUtils::is_real(*type)) { \ - err("Argument of the `"#X"` function must be either Real", \ - args[0]->base.loc); \ - } \ - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_##X, \ - static_cast(IntrinsicScalarFunctions::X), 0, type); \ - } \ -} // namespace X - -create_exp_macro(Exp, exp) -create_exp_macro(Exp2, exp2) -create_exp_macro(Expm1, expm1) - -namespace ListIndex { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args <= 4, "Call to list.index must have at most four arguments", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])) && - ASRUtils::check_equal_type(ASRUtils::expr_type(x.m_args[1]), - ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), - "First argument to list.index must be of list type and " - "second argument must be of same type as list elemental type", - x.base.base.loc, diagnostics); - if(x.n_args >= 3) { - ASRUtils::require_impl( - ASR::is_a(*ASRUtils::expr_type(x.m_args[2])), - "Third argument to list.index must be an integer", - x.base.base.loc, diagnostics); - } - if(x.n_args == 4) { - ASRUtils::require_impl( - ASR::is_a(*ASRUtils::expr_type(x.m_args[3])), - "Fourth argument to list.index must be an integer", - x.base.base.loc, diagnostics); - } - ASRUtils::require_impl(ASR::is_a(*x.m_type), - "Return type of list.index must be an integer", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_list_index(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/) { - // TODO: To be implemented for ListConstant expression - return nullptr; -} - - -static inline ASR::asr_t* create_ListIndex(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - int64_t overload_id = 0; - ASR::expr_t* list_expr = args[0]; - ASR::ttype_t *type = ASRUtils::expr_type(list_expr); - ASR::ttype_t *list_type = ASR::down_cast(type)->m_type; - ASR::ttype_t *ele_type = ASRUtils::expr_type(args[1]); - if (!ASRUtils::check_equal_type(ele_type, list_type)) { - std::string fnd = ASRUtils::get_type_code(ele_type); - std::string org = ASRUtils::get_type_code(list_type); - err( - "Type mismatch in 'index', the types must be compatible " - "(found: '" + fnd + "', expected: '" + org + "')", loc); - } - if (args.size() >= 3) { - overload_id = 1; - if(!ASR::is_a(*ASRUtils::expr_type(args[2]))) { - err("Third argument to list.index must be an integer", loc); - } - } - if (args.size() == 4) { - overload_id = 2; - if(!ASR::is_a(*ASRUtils::expr_type(args[3]))) { - err("Fourth argument to list.index must be an integer", loc); - } - } - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::ttype_t *to_type = int32; - ASR::expr_t* compile_time_value = eval_list_index(al, loc, to_type, arg_values); - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::ListIndex), - args.p, args.size(), overload_id, to_type, compile_time_value); -} - -} // namespace ListIndex - -namespace ListReverse { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, "Call to list.reverse must have exactly one argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "Argument to list.reverse must be of list type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(x.m_type == nullptr, - "Return type of list.reverse must be empty", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_list_reverse(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/) { - // TODO: To be implemented for ListConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_ListReverse(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 1) { - err("list.reverse() takes no arguments", loc); - } - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::expr_t* compile_time_value = eval_list_reverse(al, loc, nullptr, arg_values); - return ASR::make_Expr_t(al, loc, - ASRUtils::EXPR(ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, - static_cast(IntrinsicScalarFunctions::ListReverse), - args.p, args.size(), 0, nullptr, compile_time_value))); -} - -} // namespace ListReverse - -namespace ListPop { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args <= 2, "Call to list.pop must have at most one argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "Argument to list.pop must be of list type", - x.base.base.loc, diagnostics); - switch(x.m_overload_id) { - case 0: - break; - case 1: - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[1])), - "Argument to list.pop must be an integer", - x.base.base.loc, diagnostics); - break; - } - ASRUtils::require_impl(ASRUtils::check_equal_type(x.m_type, - ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), - "Return type of list.pop must be of same type as list's element type", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_list_pop(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/) { - // TODO: To be implemented for ListConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_ListPop(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() > 2) { - err("Call to list.pop must have at most one argument", loc); - } - if (args.size() == 2 && - !ASR::is_a(*ASRUtils::expr_type(args[1]))) { - err("Argument to list.pop must be an integer", loc); - } - - ASR::expr_t* list_expr = args[0]; - ASR::ttype_t *type = ASRUtils::expr_type(list_expr); - ASR::ttype_t *list_type = ASR::down_cast(type)->m_type; - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::ttype_t *to_type = list_type; - ASR::expr_t* compile_time_value = eval_list_pop(al, loc, to_type, arg_values); - int64_t overload_id = (args.size() == 2); - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::ListPop), - args.p, args.size(), overload_id, to_type, compile_time_value); -} - -} // namespace ListPop - -namespace Reserve { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, "Call to reserve must have exactly one argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "First argument to reserve must be of list type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[1])), - "Second argument to reserve must be an integer", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(x.m_type == nullptr, - "Return type of reserve must be empty", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_reserve(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO: To be implemented for ListConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_Reserve(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Call to reserve must have exactly two argument", loc); - } - if (!ASR::is_a(*ASRUtils::expr_type(args[0]))) { - err("First argument to reserve must be of list type", loc); - } - if (!ASR::is_a(*ASRUtils::expr_type(args[1]))) { - err("Second argument to reserve must be an integer", loc); - } - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::expr_t* compile_time_value = eval_reserve(al, loc, nullptr, arg_values); - return ASR::make_Expr_t(al, loc, - ASRUtils::EXPR(ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, - static_cast(IntrinsicScalarFunctions::Reserve), - args.p, args.size(), 0, nullptr, compile_time_value))); -} - -} // namespace Reserve - -namespace DictKeys { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, "Call to dict.keys must have no argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "Argument to dict.keys must be of dict type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*x.m_type) && - ASRUtils::check_equal_type(ASRUtils::get_contained_type(x.m_type), - ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]), 0)), - "Return type of dict.keys must be of list of dict key element type", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_dict_keys(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO: To be implemented for DictConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_DictKeys(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 1) { - err("Call to dict.keys must have no argument", loc); - } - - ASR::expr_t* dict_expr = args[0]; - ASR::ttype_t *type = ASRUtils::expr_type(dict_expr); - ASR::ttype_t *dict_keys_type = ASR::down_cast(type)->m_key_type; - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::ttype_t *to_type = List(dict_keys_type); - ASR::expr_t* compile_time_value = eval_dict_keys(al, loc, to_type, arg_values); - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::DictKeys), - args.p, args.size(), 0, to_type, compile_time_value); -} - -} // namespace DictKeys - -namespace DictValues { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, "Call to dict.values must have no argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "Argument to dict.values must be of dict type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*x.m_type) && - ASRUtils::check_equal_type(ASRUtils::get_contained_type(x.m_type), - ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]), 1)), - "Return type of dict.values must be of list of dict value element type", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_dict_values(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO: To be implemented for DictConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_DictValues(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 1) { - err("Call to dict.values must have no argument", loc); - } - - ASR::expr_t* dict_expr = args[0]; - ASR::ttype_t *type = ASRUtils::expr_type(dict_expr); - ASR::ttype_t *dict_values_type = ASR::down_cast(type)->m_value_type; - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::ttype_t *to_type = List(dict_values_type); - ASR::expr_t* compile_time_value = eval_dict_values(al, loc, to_type, arg_values); - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::DictValues), - args.p, args.size(), 0, to_type, compile_time_value); -} - -} // namespace DictValues - -namespace SetAdd { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, "Call to set.add must have exactly one argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "First argument to set.add must be of set type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASRUtils::check_equal_type(ASRUtils::expr_type(x.m_args[1]), - ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), - "Second argument to set.add must be of same type as set's element type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(x.m_type == nullptr, - "Return type of set.add must be empty", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_set_add(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO: To be implemented for SetConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_SetAdd(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Call to set.add must have exactly one argument", loc); - } - if (!ASRUtils::check_equal_type(ASRUtils::expr_type(args[1]), - ASRUtils::get_contained_type(ASRUtils::expr_type(args[0])))) { - err("Argument to set.add must be of same type as set's " - "element type", loc); - } - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::expr_t* compile_time_value = eval_set_add(al, loc, nullptr, arg_values); - return ASR::make_Expr_t(al, loc, - ASRUtils::EXPR(ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::SetAdd), - args.p, args.size(), 0, nullptr, compile_time_value))); -} - -} // namespace SetAdd - -namespace SetRemove { - -static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, "Call to set.remove must have exactly one argument", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "First argument to set.remove must be of set type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASRUtils::check_equal_type(ASRUtils::expr_type(x.m_args[1]), - ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), - "Second argument to set.remove must be of same type as set's element type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(x.m_type == nullptr, - "Return type of set.remove must be empty", - x.base.base.loc, diagnostics); -} - -static inline ASR::expr_t *eval_set_remove(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO: To be implemented for SetConstant expression - return nullptr; -} - -static inline ASR::asr_t* create_SetRemove(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 2) { - err("Call to set.remove must have exactly one argument", loc); - } - if (!ASRUtils::check_equal_type(ASRUtils::expr_type(args[1]), - ASRUtils::get_contained_type(ASRUtils::expr_type(args[0])))) { - err("Argument to set.remove must be of same type as set's " - "element type", loc); - } - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - ASR::expr_t* compile_time_value = eval_set_remove(al, loc, nullptr, arg_values); - return ASR::make_Expr_t(al, loc, - ASRUtils::EXPR(ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::SetRemove), - args.p, args.size(), 0, nullptr, compile_time_value))); -} - -} // namespace SetRemove - -namespace Max { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args > 1, "ASR Verify: Call to max0 must have at least two arguments", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])) || - ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "ASR Verify: Arguments to max0 must be of real or integer type", - x.base.base.loc, diagnostics); - for(size_t i=0;i(*ASRUtils::expr_type(x.m_args[i])) && - ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))) || - (ASR::is_a(*ASRUtils::expr_type(x.m_args[i])) && - ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))), - "ASR Verify: All arguments must be of the same type", - x.base.base.loc, diagnostics); - } - } - - static ASR::expr_t *eval_Max(Allocator &al, const Location &loc, - ASR::ttype_t* arg_type, Vec &args) { - LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); - if (ASR::is_a(*arg_type)) { - double max_val = ASR::down_cast(args[0])->m_r; - for (size_t i = 1; i < args.size(); i++) { - double val = ASR::down_cast(args[i])->m_r; - max_val = std::fmax(max_val, val); - } - return ASR::down_cast(ASR::make_RealConstant_t(al, loc, max_val, arg_type)); - } else if (ASR::is_a(*arg_type)) { - int64_t max_val = ASR::down_cast(args[0])->m_n; - for (size_t i = 1; i < args.size(); i++) { - int64_t val = ASR::down_cast(args[i])->m_n; - max_val = std::fmax(max_val, val); - } - return ASR::down_cast(ASR::make_IntegerConstant_t(al, loc, max_val, arg_type)); - } else { - return nullptr; - } - } - - static inline ASR::asr_t* create_Max( - Allocator& al, const Location& loc, Vec& args, - const std::function err) { - bool is_compile_time = true; - for(size_t i=0; i<100;i++){ - args.erase(nullptr); - } - if (args.size() < 2) { - err("Intrinsic max0 must have 2 arguments", loc); - } - Vec arg_values; - arg_values.reserve(al, args.size()); - ASR::expr_t *arg_value; - for(size_t i=0;i(IntrinsicScalarFunctions::Max), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), value); - } else { - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Max), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), nullptr); - } - } - - static inline ASR::expr_t* instantiate_Max(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string func_name = "_lcompilers_max0_" + type_to_str_python(arg_types[0]); - std::string fn_name = scope->get_unique_name(func_name); - SymbolTable *fn_symtab = al.make_new(scope); - Vec args; - args.reserve(al, new_args.size()); - ASRBuilder b(al, loc); - Vec body; body.reserve(al, args.size()); - SetChar dep; dep.reserve(al, 1); - if (scope->get_symbol(fn_name)) { - ASR::symbol_t *s = scope->get_symbol(fn_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); - } - for (size_t i = 0; i < new_args.size(); i++) { - fill_func_arg("x" + std::to_string(i), arg_types[0]); - } - - auto result = declare(fn_name, return_type, ReturnVar); - - ASR::expr_t* test; - body.push_back(al, b.Assignment(result, args[0])); - for (size_t i = 1; i < args.size(); i++) { - test = make_Compare(make_IntegerCompare_t, args[i], Gt, result); - Vec if_body; if_body.reserve(al, 1); - if_body.push_back(al, b.Assignment(result, args[i])); - body.push_back(al, STMT(ASR::make_If_t(al, loc, test, - if_body.p, if_body.n, nullptr, 0))); - } - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Max - -namespace Min { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args > 1, "ASR Verify: Call to min0 must have at least two arguments", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])) || - ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), - "ASR Verify: Arguments to min0 must be of real or integer type", - x.base.base.loc, diagnostics); - for(size_t i=0;i(*ASRUtils::expr_type(x.m_args[i])) && - ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))) || - (ASR::is_a(*ASRUtils::expr_type(x.m_args[i])) && - ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))), - "ASR Verify: All arguments must be of the same type", - x.base.base.loc, diagnostics); - } - } - - static ASR::expr_t *eval_Min(Allocator &al, const Location &loc, - ASR::ttype_t *arg_type, Vec &args) { - LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); - if (ASR::is_a(*arg_type)) { - double min_val = ASR::down_cast(args[0])->m_r; - for (size_t i = 1; i < args.size(); i++) { - double val = ASR::down_cast(args[i])->m_r; - min_val = std::fmin(min_val, val); - } - return ASR::down_cast(ASR::make_RealConstant_t(al, loc, min_val, arg_type)); - } else if (ASR::is_a(*arg_type)) { - int64_t min_val = ASR::down_cast(args[0])->m_n; - for (size_t i = 1; i < args.size(); i++) { - int64_t val = ASR::down_cast(args[i])->m_n; - min_val = std::fmin(min_val, val); - } - return ASR::down_cast(ASR::make_IntegerConstant_t(al, loc, min_val, arg_type)); - } else { - return nullptr; - } - } - - static inline ASR::asr_t* create_Min( - Allocator& al, const Location& loc, Vec& args, - const std::function err) { - bool is_compile_time = true; - for(size_t i=0; i<100;i++){ - args.erase(nullptr); - } - if (args.size() < 2) { - err("Intrinsic min0 must have 2 arguments", loc); - } - Vec arg_values; - arg_values.reserve(al, args.size()); - ASR::expr_t *arg_value; - for(size_t i=0;i(IntrinsicScalarFunctions::Min), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), value); - } else { - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Min), - args.p, args.n, 0, ASRUtils::expr_type(args[0]), nullptr); - } - } - - static inline ASR::expr_t* instantiate_Min(Allocator &al, const Location &loc, - SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - std::string func_name = "_lcompilers_min0_" + type_to_str_python(arg_types[0]); - std::string fn_name = scope->get_unique_name(func_name); - SymbolTable *fn_symtab = al.make_new(scope); - Vec args; - args.reserve(al, new_args.size()); - ASRBuilder b(al, loc); - Vec body; body.reserve(al, args.size()); - SetChar dep; dep.reserve(al, 1); - if (scope->get_symbol(fn_name)) { - ASR::symbol_t *s = scope->get_symbol(fn_name); - ASR::Function_t *f = ASR::down_cast(s); - return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); - } - for (size_t i = 0; i < new_args.size(); i++) { - fill_func_arg("x" + std::to_string(i), arg_types[0]); - } - - auto result = declare(fn_name, return_type, ReturnVar); - - ASR::expr_t* test; - body.push_back(al, b.Assignment(result, args[0])); - if (return_type->type == ASR::ttypeType::Integer) { - for (size_t i = 1; i < args.size(); i++) { - test = make_Compare(make_IntegerCompare_t, args[i], Lt, result); - Vec if_body; if_body.reserve(al, 1); - if_body.push_back(al, b.Assignment(result, args[i])); - body.push_back(al, STMT(ASR::make_If_t(al, loc, test, - if_body.p, if_body.n, nullptr, 0))); - } - } else if (return_type->type == ASR::ttypeType::Real) { - for (size_t i = 1; i < args.size(); i++) { - test = make_Compare(make_RealCompare_t, args[i], Lt, result); - Vec if_body; if_body.reserve(al, 1); - if_body.push_back(al, b.Assignment(result, args[i])); - body.push_back(al, STMT(ASR::make_If_t(al, loc, test, - if_body.p, if_body.n, nullptr, 0))); - } - } else { - throw LCompilersException("Arguments to min0 must be of real or integer type"); - } - ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, f_sym); - return b.Call(f_sym, new_args, return_type, nullptr); - } - -} // namespace Min - -namespace Partition { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, "Call to partition must have exactly two arguments", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])) && - ASR::is_a(*ASRUtils::expr_type(x.m_args[1])), - "Both arguments to partition must be of character type", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*x.m_type), - "Return type of partition must be a tuple", - x.base.base.loc, diagnostics); - } - - static inline ASR::expr_t* eval_Partition(Allocator &al, const Location &loc, - std::string &s_var, std::string &sep) { - /* - using KMP algorithm to find separator inside string - res_tuple: stores the resulting 3-tuple expression ---> - (if separator exist) tuple: (left of separator, separator, right of separator) - (if separator does not exist) tuple: (string, "", "") - res_tuple_type: stores the type of each expression present in resulting 3-tuple - */ - ASRBuilder b(al, loc); - int sep_pos = ASRUtils::KMP_string_match(s_var, sep); - std::string first_res, second_res, third_res; - if(sep_pos == -1) { - /* seperator does not exist */ - first_res = s_var; - second_res = ""; - third_res = ""; - } else { - first_res = s_var.substr(0, sep_pos); - second_res = sep; - third_res = s_var.substr(sep_pos + sep.size()); - } - - Vec res_tuple; res_tuple.reserve(al, 3); - ASR::ttype_t *first_res_type = character(first_res.size()); - ASR::ttype_t *second_res_type = character(second_res.size()); - ASR::ttype_t *third_res_type = character(third_res.size()); - return b.TupleConstant({ StringConstant(first_res, first_res_type), - StringConstant(second_res, second_res_type), - StringConstant(third_res, third_res_type) }, - b.Tuple({first_res_type, second_res_type, third_res_type})); - } - - static inline ASR::asr_t *create_partition(Allocator &al, const Location &loc, - Vec &args, ASR::expr_t *s_var, - const std::function err) { - ASRBuilder b(al, loc); - if (args.size() != 1) { - err("str.partition() takes exactly one argument", loc); - } - ASR::expr_t *arg = args[0]; - if (!ASRUtils::is_character(*expr_type(arg))) { - err("str.partition() takes one arguments of type: str", arg->base.loc); - } - - Vec e_args; e_args.reserve(al, 2); - e_args.push_back(al, s_var); - e_args.push_back(al, arg); - - ASR::ttype_t *return_type = b.Tuple({character(-2), character(-2), character(-2)}); - ASR::expr_t *value = nullptr; - if (ASR::is_a(*s_var) - && ASR::is_a(*arg)) { - std::string s_sep = ASR::down_cast(arg)->m_s; - std::string s_str = ASR::down_cast(s_var)->m_s; - if (s_sep.size() == 0) { - err("Separator cannot be an empty string", arg->base.loc); - } - value = eval_Partition(al, loc, s_str, s_sep); - } - - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::Partition), - e_args.p, e_args.n, 0, return_type, value); - } - - static inline ASR::expr_t *instantiate_Partition(Allocator &al, - const Location &loc, SymbolTable *scope, - Vec& /*arg_types*/, ASR::ttype_t *return_type, - Vec& new_args, int64_t /*overload_id*/) { - // TODO: show runtime error for empty separator or pattern - declare_basic_variables("_lpython_str_partition"); - fill_func_arg("target_string", character(-2)); - fill_func_arg("pattern", character(-2)); - - auto result = declare("result", return_type, ReturnVar); - auto index = declare("index", int32, Local); - body.push_back(al, b.Assignment(index, b.Call(UnaryIntrinsicFunction:: - create_KMP_function(al, loc, scope), args, int32))); - body.push_back(al, b.If(iEq(index, i32_n(-1)), { - b.Assignment(result, b.TupleConstant({ args[0], - StringConstant("", character(0)), - StringConstant("", character(0)) }, - b.Tuple({character(-2), character(0), character(0)}))) - }, { - b.Assignment(result, b.TupleConstant({ - StringSection(args[0], i32(0), index), args[1], - StringSection(args[0], iAdd(index, StringLen(args[1])), - StringLen(args[0]))}, return_type)) - })); - body.push_back(al, Return()); - ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, - body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); - scope->add_symbol(fn_name, fn_sym); - return b.Call(fn_sym, new_args, return_type, nullptr); - } - -} // namespace Partition - -namespace SymbolicSymbol { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - const Location& loc = x.base.base.loc; - ASRUtils::require_impl(x.n_args == 1, - "SymbolicSymbol intrinsic must have exactly 1 input argument", - loc, diagnostics); - - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); - ASRUtils::require_impl(ASR::is_a(*input_type), - "SymbolicSymbol intrinsic expects a character input argument", - loc, diagnostics); - } - - static inline ASR::expr_t *eval_SymbolicSymbol(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO - return nullptr; - } - - static inline ASR::asr_t* create_SymbolicSymbol(Allocator& al, const Location& loc, - Vec& args, - const std::function err) { - if (args.size() != 1) { - err("Intrinsic Symbol function accepts exactly 1 argument", loc); - } - - ASR::ttype_t *type = ASRUtils::expr_type(args[0]); - if (!ASRUtils::is_character(*type)) { - err("Argument of the Symbol function must be a Character", - args[0]->base.loc); - } - - ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_SymbolicSymbol, - static_cast(IntrinsicScalarFunctions::SymbolicSymbol), 0, to_type); - } - -} // namespace SymbolicSymbol - -#define create_symbolic_binary_macro(X) \ -namespace X{ \ - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, \ - diag::Diagnostics& diagnostics) { \ - ASRUtils::require_impl(x.n_args == 2, "Intrinsic function `"#X"` accepts" \ - "exactly 2 arguments", x.base.base.loc, diagnostics); \ - \ - ASR::ttype_t* left_type = ASRUtils::expr_type(x.m_args[0]); \ - ASR::ttype_t* right_type = ASRUtils::expr_type(x.m_args[1]); \ - \ - ASRUtils::require_impl(ASR::is_a(*left_type) && \ - ASR::is_a(*right_type), \ - "Both arguments of `"#X"` must be of type SymbolicExpression", \ - x.base.base.loc, diagnostics); \ - } \ - \ - static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ - ASR::ttype_t *, Vec &/*args*/) { \ - /*TODO*/ \ - return nullptr; \ - } \ - \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function err) { \ - if (args.size() != 2) { \ - err("Intrinsic function `"#X"` accepts exactly 2 arguments", loc); \ - } \ - \ - for (size_t i = 0; i < args.size(); i++) { \ - ASR::ttype_t* argtype = ASRUtils::expr_type(args[i]); \ - if(!ASR::is_a(*argtype)) { \ - err("Arguments of `"#X"` function must be of type SymbolicExpression", \ - args[i]->base.loc); \ - } \ - } \ - \ - Vec arg_values; \ - arg_values.reserve(al, args.size()); \ - for( size_t i = 0; i < args.size(); i++ ) { \ - arg_values.push_back(al, ASRUtils::expr_value(args[i])); \ - } \ - ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); \ - ASR::expr_t* compile_time_value = eval_##X(al, loc, to_type, arg_values); \ - return ASR::make_IntrinsicScalarFunction_t(al, loc, \ - static_cast(IntrinsicScalarFunctions::X), \ - args.p, args.size(), 0, to_type, compile_time_value); \ - } \ -} // namespace X - -create_symbolic_binary_macro(SymbolicAdd) -create_symbolic_binary_macro(SymbolicSub) -create_symbolic_binary_macro(SymbolicMul) -create_symbolic_binary_macro(SymbolicDiv) -create_symbolic_binary_macro(SymbolicPow) -create_symbolic_binary_macro(SymbolicDiff) - -#define create_symbolic_constants_macro(X) \ -namespace X { \ - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, \ - diag::Diagnostics& diagnostics) { \ - const Location& loc = x.base.base.loc; \ - ASRUtils::require_impl(x.n_args == 0, \ - #X " does not take arguments", loc, diagnostics); \ - } \ - \ - static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ - ASR::ttype_t *, Vec &/*args*/) { \ - /*TODO*/ \ - return nullptr; \ - } \ - \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function /*err*/) { \ - ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); \ - ASR::expr_t* compile_time_value = eval_##X(al, loc, to_type, args); \ - return ASR::make_IntrinsicScalarFunction_t(al, loc, \ - static_cast(IntrinsicScalarFunctions::X), \ - nullptr, 0, 0, to_type, compile_time_value); \ - } \ -} // namespace X - -create_symbolic_constants_macro(SymbolicPi) -create_symbolic_constants_macro(SymbolicE) - -namespace SymbolicInteger { - - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 1, - "SymbolicInteger intrinsic must have exactly 1 input argument", - x.base.base.loc, diagnostics); - - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); - ASRUtils::require_impl(ASR::is_a(*input_type), - "SymbolicInteger intrinsic expects an integer input argument", - x.base.base.loc, diagnostics); - } - - static inline ASR::expr_t* eval_SymbolicInteger(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/) { - // TODO - return nullptr; - } - - static inline ASR::asr_t* create_SymbolicInteger(Allocator& al, const Location& loc, - Vec& args, - const std::function /*err*/) { - ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_SymbolicInteger, - static_cast(IntrinsicScalarFunctions::SymbolicInteger), 0, to_type); - } - -} // namespace SymbolicInteger - -namespace SymbolicHasSymbolQ { - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, "Intrinsic function SymbolicHasSymbolQ" - "accepts exactly 2 arguments", x.base.base.loc, diagnostics); - - ASR::ttype_t* left_type = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t* right_type = ASRUtils::expr_type(x.m_args[1]); - - ASRUtils::require_impl(ASR::is_a(*left_type) && - ASR::is_a(*right_type), - "Both arguments of SymbolicHasSymbolQ must be of type SymbolicExpression", - x.base.base.loc, diagnostics); - } - - static inline ASR::expr_t* eval_SymbolicHasSymbolQ(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec &/*args*/) { - /*TODO*/ - return nullptr; - } - - static inline ASR::asr_t* create_SymbolicHasSymbolQ(Allocator& al, - const Location& loc, Vec& args, - const std::function err) { - - if (args.size() != 2) { - err("Intrinsic function SymbolicHasSymbolQ accepts exactly 2 arguments", loc); - } - - for (size_t i = 0; i < args.size(); i++) { - ASR::ttype_t* argtype = ASRUtils::expr_type(args[i]); - if(!ASR::is_a(*argtype)) { - err("Arguments of SymbolicHasSymbolQ function must be of type SymbolicExpression", - args[i]->base.loc); - } - } - - Vec arg_values; - arg_values.reserve(al, args.size()); - for( size_t i = 0; i < args.size(); i++ ) { - arg_values.push_back(al, ASRUtils::expr_value(args[i])); - } - - ASR::expr_t* compile_time_value = eval_SymbolicHasSymbolQ(al, loc, logical, arg_values); - return ASR::make_IntrinsicScalarFunction_t(al, loc, - static_cast(IntrinsicScalarFunctions::SymbolicHasSymbolQ), - args.p, args.size(), 0, logical, compile_time_value); - } -} // namespace SymbolicHasSymbolQ - -namespace SymbolicGetArgument { - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, - diag::Diagnostics& diagnostics) { - ASRUtils::require_impl(x.n_args == 2, "Intrinsic function SymbolicGetArgument" - "accepts exactly 2 argument", x.base.base.loc, diagnostics); - - ASR::ttype_t* arg1_type = ASRUtils::expr_type(x.m_args[0]); - ASR::ttype_t* arg2_type = ASRUtils::expr_type(x.m_args[1]); - ASRUtils::require_impl(ASR::is_a(*arg1_type), - "SymbolicGetArgument expects the first argument to be of type SymbolicExpression", - x.base.base.loc, diagnostics); - ASRUtils::require_impl(ASR::is_a(*arg2_type), - "SymbolicGetArgument expects the second argument to be of type Integer", - x.base.base.loc, diagnostics); - } - - static inline ASR::expr_t* eval_SymbolicGetArgument(Allocator &/*al*/, - const Location &/*loc*/, ASR::ttype_t *, Vec &/*args*/) { - /*TODO*/ - return nullptr; +#define INTRINSIC_NAME_CASE(X) \ + case (static_cast(ASRUtils::IntrinsicElementalFunctions::X)) : { \ + return #X; \ } - static inline ASR::asr_t* create_SymbolicGetArgument(Allocator& al, - const Location& loc, Vec& args, - const std::function err) { - - if (args.size() != 2) { - err("Intrinsic function SymbolicGetArguments accepts exactly 2 argument", loc); - } - - ASR::ttype_t* arg1_type = ASRUtils::expr_type(args[0]); - ASR::ttype_t* arg2_type = ASRUtils::expr_type(args[1]); - if (!ASR::is_a(*arg1_type)) { - err("The first argument of SymbolicGetArgument function must be of type SymbolicExpression", - args[0]->base.loc); - } - if (!ASR::is_a(*arg2_type)) { - err("The second argument of SymbolicGetArgument function must be of type Integer", - args[1]->base.loc); +inline std::string get_intrinsic_name(int x) { + switch (x) { + INTRINSIC_NAME_CASE(ObjectType) + INTRINSIC_NAME_CASE(Kind) + INTRINSIC_NAME_CASE(Rank) + INTRINSIC_NAME_CASE(Sin) + INTRINSIC_NAME_CASE(Cos) + INTRINSIC_NAME_CASE(Tan) + INTRINSIC_NAME_CASE(Asin) + INTRINSIC_NAME_CASE(Acos) + INTRINSIC_NAME_CASE(Atan) + INTRINSIC_NAME_CASE(Sinh) + INTRINSIC_NAME_CASE(Cosh) + INTRINSIC_NAME_CASE(Tanh) + INTRINSIC_NAME_CASE(Atan2) + INTRINSIC_NAME_CASE(Asinh) + INTRINSIC_NAME_CASE(Acosh) + INTRINSIC_NAME_CASE(Atanh) + INTRINSIC_NAME_CASE(Erf) + INTRINSIC_NAME_CASE(Erfc) + INTRINSIC_NAME_CASE(Gamma) + INTRINSIC_NAME_CASE(Log) + INTRINSIC_NAME_CASE(Log10) + INTRINSIC_NAME_CASE(LogGamma) + INTRINSIC_NAME_CASE(Trunc) + INTRINSIC_NAME_CASE(Fix) + INTRINSIC_NAME_CASE(Abs) + INTRINSIC_NAME_CASE(Aimag) + INTRINSIC_NAME_CASE(Exp) + INTRINSIC_NAME_CASE(Exp2) + INTRINSIC_NAME_CASE(Expm1) + INTRINSIC_NAME_CASE(FMA) + INTRINSIC_NAME_CASE(FlipSign) + INTRINSIC_NAME_CASE(FloorDiv) + INTRINSIC_NAME_CASE(Mod) + INTRINSIC_NAME_CASE(Trailz) + INTRINSIC_NAME_CASE(BesselJ0) + INTRINSIC_NAME_CASE(BesselJ1) + INTRINSIC_NAME_CASE(BesselY0) + INTRINSIC_NAME_CASE(Mvbits) + INTRINSIC_NAME_CASE(Shiftr) + INTRINSIC_NAME_CASE(Rshift) + INTRINSIC_NAME_CASE(Shiftl) + INTRINSIC_NAME_CASE(Dshiftl) + INTRINSIC_NAME_CASE(Ishft) + INTRINSIC_NAME_CASE(Bgt) + INTRINSIC_NAME_CASE(Blt) + INTRINSIC_NAME_CASE(Bge) + INTRINSIC_NAME_CASE(Ble) + INTRINSIC_NAME_CASE(Lgt) + INTRINSIC_NAME_CASE(Llt) + INTRINSIC_NAME_CASE(Lge) + INTRINSIC_NAME_CASE(Lle) + INTRINSIC_NAME_CASE(Exponent) + INTRINSIC_NAME_CASE(Fraction) + INTRINSIC_NAME_CASE(SetExponent) + INTRINSIC_NAME_CASE(Not) + INTRINSIC_NAME_CASE(Iand) + INTRINSIC_NAME_CASE(Ior) + INTRINSIC_NAME_CASE(Ieor) + INTRINSIC_NAME_CASE(Ibclr) + INTRINSIC_NAME_CASE(Ibset) + INTRINSIC_NAME_CASE(Btest) + INTRINSIC_NAME_CASE(Ibits) + INTRINSIC_NAME_CASE(Leadz) + INTRINSIC_NAME_CASE(ToLowerCase) + INTRINSIC_NAME_CASE(Digits) + INTRINSIC_NAME_CASE(Rrspacing) + INTRINSIC_NAME_CASE(Repeat) + INTRINSIC_NAME_CASE(StringContainsSet) + INTRINSIC_NAME_CASE(StringFindSet) + INTRINSIC_NAME_CASE(SubstrIndex) + INTRINSIC_NAME_CASE(Range) + INTRINSIC_NAME_CASE(Hypot) + INTRINSIC_NAME_CASE(SelectedIntKind) + INTRINSIC_NAME_CASE(SelectedRealKind) + INTRINSIC_NAME_CASE(SelectedCharKind) + INTRINSIC_NAME_CASE(Adjustl) + INTRINSIC_NAME_CASE(Adjustr) + INTRINSIC_NAME_CASE(Ichar) + INTRINSIC_NAME_CASE(Char) + INTRINSIC_NAME_CASE(MinExponent) + INTRINSIC_NAME_CASE(MaxExponent) + INTRINSIC_NAME_CASE(Ishftc) + INTRINSIC_NAME_CASE(ListIndex) + INTRINSIC_NAME_CASE(Partition) + INTRINSIC_NAME_CASE(ListReverse) + INTRINSIC_NAME_CASE(ListPop) + INTRINSIC_NAME_CASE(ListReserve) + INTRINSIC_NAME_CASE(DictKeys) + INTRINSIC_NAME_CASE(DictValues) + INTRINSIC_NAME_CASE(SetAdd) + INTRINSIC_NAME_CASE(SetRemove) + INTRINSIC_NAME_CASE(Max) + INTRINSIC_NAME_CASE(Min) + INTRINSIC_NAME_CASE(Sign) + INTRINSIC_NAME_CASE(SignFromValue) + INTRINSIC_NAME_CASE(Nint) + INTRINSIC_NAME_CASE(Aint) + INTRINSIC_NAME_CASE(Popcnt) + INTRINSIC_NAME_CASE(Poppar) + INTRINSIC_NAME_CASE(Dim) + INTRINSIC_NAME_CASE(Anint) + INTRINSIC_NAME_CASE(Sqrt) + INTRINSIC_NAME_CASE(Scale) + INTRINSIC_NAME_CASE(Sngl) + INTRINSIC_NAME_CASE(Ifix) + INTRINSIC_NAME_CASE(Idint) + INTRINSIC_NAME_CASE(Floor) + INTRINSIC_NAME_CASE(Ceiling) + INTRINSIC_NAME_CASE(Maskr) + INTRINSIC_NAME_CASE(Maskl) + INTRINSIC_NAME_CASE(Epsilon) + INTRINSIC_NAME_CASE(Precision) + INTRINSIC_NAME_CASE(Tiny) + INTRINSIC_NAME_CASE(Conjg) + INTRINSIC_NAME_CASE(Huge) + INTRINSIC_NAME_CASE(Dprod) + INTRINSIC_NAME_CASE(SymbolicSymbol) + INTRINSIC_NAME_CASE(SymbolicAdd) + INTRINSIC_NAME_CASE(SymbolicSub) + INTRINSIC_NAME_CASE(SymbolicMul) + INTRINSIC_NAME_CASE(SymbolicDiv) + INTRINSIC_NAME_CASE(SymbolicPow) + INTRINSIC_NAME_CASE(SymbolicPi) + INTRINSIC_NAME_CASE(SymbolicE) + INTRINSIC_NAME_CASE(SymbolicInteger) + INTRINSIC_NAME_CASE(SymbolicDiff) + INTRINSIC_NAME_CASE(SymbolicExpand) + INTRINSIC_NAME_CASE(SymbolicSin) + INTRINSIC_NAME_CASE(SymbolicCos) + INTRINSIC_NAME_CASE(SymbolicLog) + INTRINSIC_NAME_CASE(SymbolicExp) + INTRINSIC_NAME_CASE(SymbolicAbs) + INTRINSIC_NAME_CASE(SymbolicHasSymbolQ) + INTRINSIC_NAME_CASE(SymbolicAddQ) + INTRINSIC_NAME_CASE(SymbolicMulQ) + INTRINSIC_NAME_CASE(SymbolicPowQ) + INTRINSIC_NAME_CASE(SymbolicLogQ) + INTRINSIC_NAME_CASE(SymbolicSinQ) + INTRINSIC_NAME_CASE(SymbolicGetArgument) + default : { + throw LCompilersException("pickle: intrinsic_id not implemented"); } - - ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_SymbolicGetArgument, - static_cast(IntrinsicScalarFunctions::SymbolicGetArgument), - 0, to_type); } -} // namespace SymbolicGetArgument - -#define create_symbolic_query_macro(X) \ -namespace X { \ - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, \ - diag::Diagnostics& diagnostics) { \ - const Location& loc = x.base.base.loc; \ - ASRUtils::require_impl(x.n_args == 1, \ - #X " must have exactly 1 input argument", loc, diagnostics); \ - \ - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); \ - ASRUtils::require_impl(ASR::is_a(*input_type), \ - #X " expects an argument of type SymbolicExpression", loc, diagnostics); \ - } \ - \ - static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ - ASR::ttype_t *, Vec &/*args*/) { \ - /*TODO*/ \ - return nullptr; \ - } \ - \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function err) { \ - if (args.size() != 1) { \ - err("Intrinsic " #X " function accepts exactly 1 argument", loc); \ - } \ - \ - ASR::ttype_t* argtype = ASRUtils::expr_type(args[0]); \ - if (!ASR::is_a(*argtype)) { \ - err("Argument of " #X " function must be of type SymbolicExpression", \ - args[0]->base.loc); \ - } \ - \ - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_##X, \ - static_cast(IntrinsicScalarFunctions::X), 0, logical); \ - } \ -} // namespace X - -create_symbolic_query_macro(SymbolicAddQ) -create_symbolic_query_macro(SymbolicMulQ) -create_symbolic_query_macro(SymbolicPowQ) -create_symbolic_query_macro(SymbolicLogQ) -create_symbolic_query_macro(SymbolicSinQ) - -#define create_symbolic_unary_macro(X) \ -namespace X { \ - static inline void verify_args(const ASR::IntrinsicScalarFunction_t& x, \ - diag::Diagnostics& diagnostics) { \ - const Location& loc = x.base.base.loc; \ - ASRUtils::require_impl(x.n_args == 1, \ - #X " must have exactly 1 input argument", loc, diagnostics); \ - \ - ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); \ - ASRUtils::require_impl(ASR::is_a(*input_type), \ - #X " expects an argument of type SymbolicExpression", loc, diagnostics); \ - } \ - \ - static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ - ASR::ttype_t *, Vec &/*args*/) { \ - /*TODO*/ \ - return nullptr; \ - } \ - \ - static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ - Vec& args, \ - const std::function err) { \ - if (args.size() != 1) { \ - err("Intrinsic " #X " function accepts exactly 1 argument", loc); \ - } \ - \ - ASR::ttype_t* argtype = ASRUtils::expr_type(args[0]); \ - if (!ASR::is_a(*argtype)) { \ - err("Argument of " #X " function must be of type SymbolicExpression", \ - args[0]->base.loc); \ - } \ - \ - ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); \ - return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_##X, \ - static_cast(IntrinsicScalarFunctions::X), 0, to_type); \ - } \ -} // namespace X - -create_symbolic_unary_macro(SymbolicSin) -create_symbolic_unary_macro(SymbolicCos) -create_symbolic_unary_macro(SymbolicLog) -create_symbolic_unary_macro(SymbolicExp) -create_symbolic_unary_macro(SymbolicAbs) -create_symbolic_unary_macro(SymbolicExpand) - +} -namespace IntrinsicScalarFunctionRegistry { +namespace IntrinsicElementalFunctionRegistry { static const std::map>& intrinsic_function_by_id_db = { - {static_cast(IntrinsicScalarFunctions::LogGamma), + {static_cast(IntrinsicElementalFunctions::ObjectType), + {nullptr, &ObjectType::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Gamma), + {&Gamma::instantiate_Gamma, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Log10), + {&Log10::instantiate_Log10, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Log), + {&Log::instantiate_Log, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::LogGamma), {&LogGamma::instantiate_LogGamma, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Trunc), + {static_cast(IntrinsicElementalFunctions::Erf), + {&Erf::instantiate_Erf, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Erfc), + {&Erfc::instantiate_Erfc, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Trunc), {&Trunc::instantiate_Trunc, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Fix), + {static_cast(IntrinsicElementalFunctions::Fix), {&Fix::instantiate_Fix, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Sin), + {static_cast(IntrinsicElementalFunctions::Sin), {&Sin::instantiate_Sin, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Cos), + {static_cast(IntrinsicElementalFunctions::Cos), {&Cos::instantiate_Cos, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Tan), + {static_cast(IntrinsicElementalFunctions::Tan), {&Tan::instantiate_Tan, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Asin), + {static_cast(IntrinsicElementalFunctions::Asin), {&Asin::instantiate_Asin, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Acos), + {static_cast(IntrinsicElementalFunctions::Acos), {&Acos::instantiate_Acos, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Atan), + {static_cast(IntrinsicElementalFunctions::Atan), {&Atan::instantiate_Atan, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Sinh), + {static_cast(IntrinsicElementalFunctions::Sinh), {&Sinh::instantiate_Sinh, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Cosh), + {static_cast(IntrinsicElementalFunctions::Cosh), {&Cosh::instantiate_Cosh, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Tanh), + {static_cast(IntrinsicElementalFunctions::Tanh), {&Tanh::instantiate_Tanh, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Atan2), + {static_cast(IntrinsicElementalFunctions::Atan2), {&Atan2::instantiate_Atan2, &BinaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Exp), - {nullptr, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Exp2), + {static_cast(IntrinsicElementalFunctions::Asinh), + {&Asinh::instantiate_Asinh, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Acosh), + {&Acosh::instantiate_Acosh, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Atanh), + {&Atanh::instantiate_Atanh, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Exp), + {&Exp::instantiate_Exp, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Exp2), {nullptr, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Expm1), + {static_cast(IntrinsicElementalFunctions::Expm1), {nullptr, &UnaryIntrinsicFunction::verify_args}}, - {static_cast(IntrinsicScalarFunctions::FMA), + {static_cast(IntrinsicElementalFunctions::FMA), {&FMA::instantiate_FMA, &FMA::verify_args}}, - {static_cast(IntrinsicScalarFunctions::FlipSign), + {static_cast(IntrinsicElementalFunctions::FlipSign), {&FlipSign::instantiate_FlipSign, &FlipSign::verify_args}}, - {static_cast(IntrinsicScalarFunctions::FloorDiv), + {static_cast(IntrinsicElementalFunctions::FloorDiv), {&FloorDiv::instantiate_FloorDiv, &FloorDiv::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Mod), + {static_cast(IntrinsicElementalFunctions::Mod), {&Mod::instantiate_Mod, &Mod::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Trailz), + {static_cast(IntrinsicElementalFunctions::Trailz), {&Trailz::instantiate_Trailz, &Trailz::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Abs), + {static_cast(IntrinsicElementalFunctions::BesselJ0), + {&BesselJ0::instantiate_BesselJ0, &BesselJ0::verify_args}}, + {static_cast(IntrinsicElementalFunctions::BesselJ1), + {&BesselJ1::instantiate_BesselJ1, &BesselJ1::verify_args}}, + {static_cast(IntrinsicElementalFunctions::BesselY0), + {&BesselY0::instantiate_BesselY0, &BesselY0::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Mvbits), + {&Mvbits::instantiate_Mvbits, &Mvbits::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Shiftr), + {&Shiftr::instantiate_Shiftr, &Shiftr::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Adjustl), + {&Adjustl::instantiate_Adjustl, &Adjustl::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Adjustr), + {&Adjustr::instantiate_Adjustr, &Adjustr::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ichar), + {&Ichar::instantiate_Ichar, &Ichar::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Char), + {&Char::instantiate_Char, &Char::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Rshift), + {&Rshift::instantiate_Rshift, &Rshift::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Shiftl), + {&Shiftl::instantiate_Shiftl, &Shiftl::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Dshiftl), + {&Dshiftl::instantiate_Dshiftl, &Dshiftl::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ishft), + {&Ishft::instantiate_Ishft, &Ishft::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Bgt), + {&Bgt::instantiate_Bgt, &Bgt::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Blt), + {&Blt::instantiate_Blt, &Blt::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Bge), + {&Bge::instantiate_Bge, &Bge::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Exponent), + {&Exponent::instantiate_Exponent, &Exponent::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Fraction), + {&Fraction::instantiate_Fraction, &Fraction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SetExponent), + {&SetExponent::instantiate_SetExponent, &SetExponent::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ble), + {&Ble::instantiate_Ble, &Ble::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Lgt), + {&Lgt::instantiate_Lgt, &Lgt::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Llt), + {&Llt::instantiate_Llt, &Llt::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Lge), + {&Lge::instantiate_Lge, &Lge::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Lle), + {&Lle::instantiate_Lle, &Lle::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Not), + {&Not::instantiate_Not, &Not::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Iand), + {&Iand::instantiate_Iand, &Iand::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ior), + {&Ior::instantiate_Ior, &Ior::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ieor), + {&Ieor::instantiate_Ieor, &Ieor::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ibclr), + {&Ibclr::instantiate_Ibclr, &Ibclr::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Btest), + {&Btest::instantiate_Btest, &Btest::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ibset), + {&Ibset::instantiate_Ibset, &Ibset::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ibits), + {&Ibits::instantiate_Ibits, &Ibits::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Leadz), + {&Leadz::instantiate_Leadz, &Leadz::verify_args}}, + {static_cast(IntrinsicElementalFunctions::ToLowerCase), + {&ToLowerCase::instantiate_ToLowerCase, &ToLowerCase::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Hypot), + {&Hypot::instantiate_Hypot, &Hypot::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Kind), + {&Kind::instantiate_Kind, &Kind::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Rank), + {nullptr, &Rank::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Digits), + {&Digits::instantiate_Digits, &Digits::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Rrspacing), + {&Rrspacing::instantiate_Rrspacing, &Rrspacing::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Repeat), + {&Repeat::instantiate_Repeat, &Repeat::verify_args}}, + {static_cast(IntrinsicElementalFunctions::StringContainsSet), + {&StringContainsSet::instantiate_StringContainsSet, &StringContainsSet::verify_args}}, + {static_cast(IntrinsicElementalFunctions::StringFindSet), + {&StringFindSet::instantiate_StringFindSet, &StringFindSet::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SubstrIndex), + {&SubstrIndex::instantiate_SubstrIndex, &SubstrIndex::verify_args}}, + {static_cast(IntrinsicElementalFunctions::MinExponent), + {&MinExponent::instantiate_MinExponent, &MinExponent::verify_args}}, + {static_cast(IntrinsicElementalFunctions::MaxExponent), + {&MaxExponent::instantiate_MaxExponent, &MaxExponent::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Abs), {&Abs::instantiate_Abs, &Abs::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Partition), + {static_cast(IntrinsicElementalFunctions::Aimag), + {&Aimag::instantiate_Aimag, &Aimag::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Partition), {&Partition::instantiate_Partition, &Partition::verify_args}}, - {static_cast(IntrinsicScalarFunctions::ListIndex), + {static_cast(IntrinsicElementalFunctions::ListIndex), {nullptr, &ListIndex::verify_args}}, - {static_cast(IntrinsicScalarFunctions::ListReverse), + {static_cast(IntrinsicElementalFunctions::ListReverse), {nullptr, &ListReverse::verify_args}}, - {static_cast(IntrinsicScalarFunctions::DictKeys), + {static_cast(IntrinsicElementalFunctions::DictKeys), {nullptr, &DictKeys::verify_args}}, - {static_cast(IntrinsicScalarFunctions::DictValues), + {static_cast(IntrinsicElementalFunctions::DictValues), {nullptr, &DictValues::verify_args}}, - {static_cast(IntrinsicScalarFunctions::ListPop), + {static_cast(IntrinsicElementalFunctions::ListPop), {nullptr, &ListPop::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Reserve), - {nullptr, &Reserve::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SetAdd), + {static_cast(IntrinsicElementalFunctions::ListReserve), + {nullptr, &ListReserve::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SetAdd), {nullptr, &SetAdd::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SetRemove), + {static_cast(IntrinsicElementalFunctions::SetRemove), {nullptr, &SetRemove::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Max), + {static_cast(IntrinsicElementalFunctions::Max), {&Max::instantiate_Max, &Max::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Min), + {static_cast(IntrinsicElementalFunctions::Min), {&Min::instantiate_Min, &Min::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Sign), + {static_cast(IntrinsicElementalFunctions::Sign), {&Sign::instantiate_Sign, &Sign::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Radix), + {static_cast(IntrinsicElementalFunctions::Radix), {nullptr, &Radix::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Aint), + {static_cast(IntrinsicElementalFunctions::Scale), + {&Scale::instantiate_Scale, &Scale::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Dprod), + {&Dprod::instantiate_Dprod, &Dprod::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Range), + {nullptr, &Range::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Aint), {&Aint::instantiate_Aint, &Aint::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Sqrt), + {static_cast(IntrinsicElementalFunctions::Popcnt), + {&Popcnt::instantiate_Popcnt, &Popcnt::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Poppar), + {&Poppar::instantiate_Poppar, &Poppar::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Nint), + {&Nint::instantiate_Nint, &Nint::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Anint), + {&Anint::instantiate_Anint, &Anint::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Dim), + {&Dim::instantiate_Dim, &Dim::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Floor), + {&Floor::instantiate_Floor, &Floor::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ceiling), + {&Ceiling::instantiate_Ceiling, &Ceiling::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Maskr), + {&Maskr::instantiate_Maskr, &Maskr::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Maskl), + {&Maskl::instantiate_Maskl, &Maskl::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Sqrt), {&Sqrt::instantiate_Sqrt, &Sqrt::verify_args}}, - {static_cast(IntrinsicScalarFunctions::Sngl), + {static_cast(IntrinsicElementalFunctions::Sngl), {&Sngl::instantiate_Sngl, &Sngl::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SignFromValue), + {static_cast(IntrinsicElementalFunctions::Ifix), + {&Ifix::instantiate_Ifix, &Ifix::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Idint), + {&Idint::instantiate_Idint, &Idint::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Ishftc), + {&Ishftc::instantiate_Ishftc, &Ishftc::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Conjg), + {&Conjg::instantiate_Conjg, &Conjg::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SignFromValue), {&SignFromValue::instantiate_SignFromValue, &SignFromValue::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicSymbol), + {static_cast(IntrinsicElementalFunctions::Epsilon), + {nullptr, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Precision), + {nullptr, &Precision::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Tiny), + {nullptr, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::Huge), + {nullptr, &UnaryIntrinsicFunction::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SelectedIntKind), + {&SelectedIntKind::instantiate_SelectedIntKind, &SelectedIntKind::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SelectedRealKind), + {&SelectedRealKind::instantiate_SelectedRealKind, &SelectedRealKind::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SelectedCharKind), + {&SelectedCharKind::instantiate_SelectedCharKind, &SelectedCharKind::verify_args}}, + {static_cast(IntrinsicElementalFunctions::SymbolicSymbol), {nullptr, &SymbolicSymbol::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicAdd), + {static_cast(IntrinsicElementalFunctions::SymbolicAdd), {nullptr, &SymbolicAdd::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicSub), + {static_cast(IntrinsicElementalFunctions::SymbolicSub), {nullptr, &SymbolicSub::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicMul), + {static_cast(IntrinsicElementalFunctions::SymbolicMul), {nullptr, &SymbolicMul::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicDiv), + {static_cast(IntrinsicElementalFunctions::SymbolicDiv), {nullptr, &SymbolicDiv::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicPow), + {static_cast(IntrinsicElementalFunctions::SymbolicPow), {nullptr, &SymbolicPow::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicPi), + {static_cast(IntrinsicElementalFunctions::SymbolicPi), {nullptr, &SymbolicPi::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicE), + {static_cast(IntrinsicElementalFunctions::SymbolicE), {nullptr, &SymbolicE::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicInteger), + {static_cast(IntrinsicElementalFunctions::SymbolicInteger), {nullptr, &SymbolicInteger::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicDiff), + {static_cast(IntrinsicElementalFunctions::SymbolicDiff), {nullptr, &SymbolicDiff::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicExpand), + {static_cast(IntrinsicElementalFunctions::SymbolicExpand), {nullptr, &SymbolicExpand::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicSin), + {static_cast(IntrinsicElementalFunctions::SymbolicSin), {nullptr, &SymbolicSin::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicCos), + {static_cast(IntrinsicElementalFunctions::SymbolicCos), {nullptr, &SymbolicCos::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicLog), + {static_cast(IntrinsicElementalFunctions::SymbolicLog), {nullptr, &SymbolicLog::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicExp), + {static_cast(IntrinsicElementalFunctions::SymbolicExp), {nullptr, &SymbolicExp::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicAbs), + {static_cast(IntrinsicElementalFunctions::SymbolicAbs), {nullptr, &SymbolicAbs::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicHasSymbolQ), + {static_cast(IntrinsicElementalFunctions::SymbolicHasSymbolQ), {nullptr, &SymbolicHasSymbolQ::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicAddQ), + {static_cast(IntrinsicElementalFunctions::SymbolicAddQ), {nullptr, &SymbolicAddQ::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicMulQ), + {static_cast(IntrinsicElementalFunctions::SymbolicMulQ), {nullptr, &SymbolicMulQ::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicPowQ), + {static_cast(IntrinsicElementalFunctions::SymbolicPowQ), {nullptr, &SymbolicPowQ::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicLogQ), + {static_cast(IntrinsicElementalFunctions::SymbolicLogQ), {nullptr, &SymbolicLogQ::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicSinQ), + {static_cast(IntrinsicElementalFunctions::SymbolicSinQ), {nullptr, &SymbolicSinQ::verify_args}}, - {static_cast(IntrinsicScalarFunctions::SymbolicGetArgument), + {static_cast(IntrinsicElementalFunctions::SymbolicGetArgument), {nullptr, &SymbolicGetArgument::verify_args}}, }; static const std::map& intrinsic_function_id_to_name = { - {static_cast(IntrinsicScalarFunctions::LogGamma), + {static_cast(IntrinsicElementalFunctions::ObjectType), + "type"}, + {static_cast(IntrinsicElementalFunctions::Gamma), + "gamma"}, + {static_cast(IntrinsicElementalFunctions::Log), + "log"}, + {static_cast(IntrinsicElementalFunctions::Log10), + "log10"}, + {static_cast(IntrinsicElementalFunctions::LogGamma), "log_gamma"}, - - {static_cast(IntrinsicScalarFunctions::Trunc), + {static_cast(IntrinsicElementalFunctions::Erf), + "erf"}, + {static_cast(IntrinsicElementalFunctions::Erfc), + "erfc"}, + {static_cast(IntrinsicElementalFunctions::Trunc), "trunc"}, - {static_cast(IntrinsicScalarFunctions::Fix), + {static_cast(IntrinsicElementalFunctions::Fix), "fix"}, - {static_cast(IntrinsicScalarFunctions::Sin), + {static_cast(IntrinsicElementalFunctions::Sin), "sin"}, - {static_cast(IntrinsicScalarFunctions::Cos), + {static_cast(IntrinsicElementalFunctions::Cos), "cos"}, - {static_cast(IntrinsicScalarFunctions::Tan), + {static_cast(IntrinsicElementalFunctions::Tan), "tan"}, - {static_cast(IntrinsicScalarFunctions::Asin), + {static_cast(IntrinsicElementalFunctions::Asin), "asin"}, - {static_cast(IntrinsicScalarFunctions::Acos), + {static_cast(IntrinsicElementalFunctions::Acos), "acos"}, - {static_cast(IntrinsicScalarFunctions::Atan), + {static_cast(IntrinsicElementalFunctions::Atan), "atan"}, - {static_cast(IntrinsicScalarFunctions::Sinh), + {static_cast(IntrinsicElementalFunctions::Sinh), "sinh"}, - {static_cast(IntrinsicScalarFunctions::Cosh), + {static_cast(IntrinsicElementalFunctions::Cosh), "cosh"}, - {static_cast(IntrinsicScalarFunctions::Tanh), + {static_cast(IntrinsicElementalFunctions::Tanh), "tanh"}, - {static_cast(IntrinsicScalarFunctions::Atan2), + {static_cast(IntrinsicElementalFunctions::Atan2), "atan2"}, - {static_cast(IntrinsicScalarFunctions::Abs), + {static_cast(IntrinsicElementalFunctions::Asinh), + "asinh"}, + {static_cast(IntrinsicElementalFunctions::Acosh), + "acosh"}, + {static_cast(IntrinsicElementalFunctions::Atanh), + "atanh"}, + {static_cast(IntrinsicElementalFunctions::Abs), "abs"}, - {static_cast(IntrinsicScalarFunctions::Exp), + {static_cast(IntrinsicElementalFunctions::Aimag), + "aimag"}, + {static_cast(IntrinsicElementalFunctions::Exp), "exp"}, - {static_cast(IntrinsicScalarFunctions::Exp2), + {static_cast(IntrinsicElementalFunctions::Exp2), "exp2"}, - {static_cast(IntrinsicScalarFunctions::FMA), + {static_cast(IntrinsicElementalFunctions::FMA), "fma"}, - {static_cast(IntrinsicScalarFunctions::FlipSign), + {static_cast(IntrinsicElementalFunctions::FlipSign), "flipsign"}, - {static_cast(IntrinsicScalarFunctions::FloorDiv), + {static_cast(IntrinsicElementalFunctions::FloorDiv), "floordiv"}, - {static_cast(IntrinsicScalarFunctions::Mod), + {static_cast(IntrinsicElementalFunctions::Mod), "mod"}, - {static_cast(IntrinsicScalarFunctions::Trailz), + {static_cast(IntrinsicElementalFunctions::Trailz), "trailz"}, - {static_cast(IntrinsicScalarFunctions::Expm1), + {static_cast(IntrinsicElementalFunctions::BesselJ0), + "bessel_j0"}, + {static_cast(IntrinsicElementalFunctions::BesselY0), + "bessel_y0"}, + {static_cast(IntrinsicElementalFunctions::Mvbits), + "mvbits"}, + {static_cast(IntrinsicElementalFunctions::Shiftr), + "shiftr"}, + {static_cast(IntrinsicElementalFunctions::Rshift), + "rshift"}, + {static_cast(IntrinsicElementalFunctions::Adjustl), + "adjustl"}, + {static_cast(IntrinsicElementalFunctions::Adjustr), + "adjustr"}, + {static_cast(IntrinsicElementalFunctions::Ichar), + "ichar"}, + {static_cast(IntrinsicElementalFunctions::Char), + "char"}, + {static_cast(IntrinsicElementalFunctions::Shiftl), + "shiftl"}, + {static_cast(IntrinsicElementalFunctions::Dshiftl), + "dshiftl"}, + {static_cast(IntrinsicElementalFunctions::Ishft), + "ishft"}, + {static_cast(IntrinsicElementalFunctions::Bgt), + "bgt"}, + {static_cast(IntrinsicElementalFunctions::Blt), + "blt"}, + {static_cast(IntrinsicElementalFunctions::Bge), + "bge"}, + {static_cast(IntrinsicElementalFunctions::Ble), + "ble"}, + {static_cast(IntrinsicElementalFunctions::Lgt), + "lgt"}, + {static_cast(IntrinsicElementalFunctions::Llt), + "llt"}, + {static_cast(IntrinsicElementalFunctions::Lge), + "lge"}, + {static_cast(IntrinsicElementalFunctions::Lle), + "lle"}, + {static_cast(IntrinsicElementalFunctions::Exponent), + "exponent"}, + {static_cast(IntrinsicElementalFunctions::Fraction), + "fraction"}, + {static_cast(IntrinsicElementalFunctions::SetExponent), + "set_exponent"}, + {static_cast(IntrinsicElementalFunctions::Not), + "not"}, + {static_cast(IntrinsicElementalFunctions::Iand), + "iand"}, + {static_cast(IntrinsicElementalFunctions::Ior), + "ior"}, + {static_cast(IntrinsicElementalFunctions::Ieor), + "ieor"}, + {static_cast(IntrinsicElementalFunctions::Ibclr), + "ibclr"}, + {static_cast(IntrinsicElementalFunctions::Ibset), + "ibset"}, + {static_cast(IntrinsicElementalFunctions::Btest), + "btest"}, + {static_cast(IntrinsicElementalFunctions::Ibits), + "ibits"}, + {static_cast(IntrinsicElementalFunctions::Leadz), + "leadz"}, + {static_cast(IntrinsicElementalFunctions::ToLowerCase), + "_lfortran_tolowercase"}, + {static_cast(IntrinsicElementalFunctions::Hypot), + "hypot"}, + {static_cast(IntrinsicElementalFunctions::SelectedIntKind), + "selected_int_kind"}, + {static_cast(IntrinsicElementalFunctions::SelectedRealKind), + "selected_real_kind"}, + {static_cast(IntrinsicElementalFunctions::SelectedCharKind), + "selected_char_kind"}, + {static_cast(IntrinsicElementalFunctions::Kind), + "kind"}, + {static_cast(IntrinsicElementalFunctions::Rank), + "rank"}, + {static_cast(IntrinsicElementalFunctions::Digits), + "Digits"}, + {static_cast(IntrinsicElementalFunctions::Rrspacing), + "rrspacing"}, + {static_cast(IntrinsicElementalFunctions::Repeat), + "Repeat"}, + {static_cast(IntrinsicElementalFunctions::StringContainsSet), + "Verify"}, + {static_cast(IntrinsicElementalFunctions::StringFindSet), + "Scan"}, + {static_cast(IntrinsicElementalFunctions::SubstrIndex), + "Index"}, + {static_cast(IntrinsicElementalFunctions::MinExponent), + "minexponent"}, + {static_cast(IntrinsicElementalFunctions::MaxExponent), + "maxexponent"}, + {static_cast(IntrinsicElementalFunctions::Expm1), "expm1"}, - {static_cast(IntrinsicScalarFunctions::ListIndex), + {static_cast(IntrinsicElementalFunctions::ListIndex), "list.index"}, - {static_cast(IntrinsicScalarFunctions::ListReverse), + {static_cast(IntrinsicElementalFunctions::ListReverse), "list.reverse"}, - {static_cast(IntrinsicScalarFunctions::ListPop), + {static_cast(IntrinsicElementalFunctions::ListPop), "list.pop"}, - {static_cast(IntrinsicScalarFunctions::Reserve), - "reserve"}, - {static_cast(IntrinsicScalarFunctions::DictKeys), + {static_cast(IntrinsicElementalFunctions::ListReserve), + "list.reserve"}, + {static_cast(IntrinsicElementalFunctions::DictKeys), "dict.keys"}, - {static_cast(IntrinsicScalarFunctions::DictValues), + {static_cast(IntrinsicElementalFunctions::DictValues), "dict.values"}, - {static_cast(IntrinsicScalarFunctions::SetAdd), + {static_cast(IntrinsicElementalFunctions::SetAdd), "set.add"}, - {static_cast(IntrinsicScalarFunctions::SetRemove), + {static_cast(IntrinsicElementalFunctions::SetRemove), "set.remove"}, - {static_cast(IntrinsicScalarFunctions::Max), + {static_cast(IntrinsicElementalFunctions::Max), "max"}, - {static_cast(IntrinsicScalarFunctions::Min), + {static_cast(IntrinsicElementalFunctions::Min), "min"}, - {static_cast(IntrinsicScalarFunctions::Radix), + {static_cast(IntrinsicElementalFunctions::Ishftc), + "ishftc"}, + {static_cast(IntrinsicElementalFunctions::Radix), "radix"}, - {static_cast(IntrinsicScalarFunctions::Sign), + {static_cast(IntrinsicElementalFunctions::Scale), + "scale"}, + {static_cast(IntrinsicElementalFunctions::Dprod), + "dprod"}, + {static_cast(IntrinsicElementalFunctions::Range), + "range"}, + {static_cast(IntrinsicElementalFunctions::Sign), "sign"}, - {static_cast(IntrinsicScalarFunctions::Aint), + {static_cast(IntrinsicElementalFunctions::Aint), "aint"}, - {static_cast(IntrinsicScalarFunctions::Sqrt), + {static_cast(IntrinsicElementalFunctions::Popcnt), + "popcnt"}, + {static_cast(IntrinsicElementalFunctions::Poppar), + "poppar"}, + {static_cast(IntrinsicElementalFunctions::Nint), + "nint"}, + {static_cast(IntrinsicElementalFunctions::Anint), + "anint"}, + {static_cast(IntrinsicElementalFunctions::Dim), + "dim"}, + {static_cast(IntrinsicElementalFunctions::Floor), + "floor"}, + {static_cast(IntrinsicElementalFunctions::Ceiling), + "ceiling"}, + {static_cast(IntrinsicElementalFunctions::Maskr), + "Maskr"}, + {static_cast(IntrinsicElementalFunctions::Maskl), + "maskl"}, + {static_cast(IntrinsicElementalFunctions::Sqrt), "sqrt"}, - {static_cast(IntrinsicScalarFunctions::Sngl), + {static_cast(IntrinsicElementalFunctions::Sngl), "sngl"}, - {static_cast(IntrinsicScalarFunctions::SignFromValue), + {static_cast(IntrinsicElementalFunctions::Idint), + "idint"}, + {static_cast(IntrinsicElementalFunctions::Ifix), + "ifix"}, + {static_cast(IntrinsicElementalFunctions::Conjg), + "conjg"}, + {static_cast(IntrinsicElementalFunctions::SignFromValue), "signfromvalue"}, - {static_cast(IntrinsicScalarFunctions::SymbolicSymbol), + {static_cast(IntrinsicElementalFunctions::Epsilon), + "epsilon"}, + {static_cast(IntrinsicElementalFunctions::Precision), + "precision"}, + {static_cast(IntrinsicElementalFunctions::Tiny), + "tiny"}, + {static_cast(IntrinsicElementalFunctions::Huge), + "huge"}, + {static_cast(IntrinsicElementalFunctions::SymbolicSymbol), "Symbol"}, - {static_cast(IntrinsicScalarFunctions::SymbolicAdd), + {static_cast(IntrinsicElementalFunctions::SymbolicAdd), "SymbolicAdd"}, - {static_cast(IntrinsicScalarFunctions::SymbolicSub), + {static_cast(IntrinsicElementalFunctions::SymbolicSub), "SymbolicSub"}, - {static_cast(IntrinsicScalarFunctions::SymbolicMul), + {static_cast(IntrinsicElementalFunctions::SymbolicMul), "SymbolicMul"}, - {static_cast(IntrinsicScalarFunctions::SymbolicDiv), + {static_cast(IntrinsicElementalFunctions::SymbolicDiv), "SymbolicDiv"}, - {static_cast(IntrinsicScalarFunctions::SymbolicPow), + {static_cast(IntrinsicElementalFunctions::SymbolicPow), "SymbolicPow"}, - {static_cast(IntrinsicScalarFunctions::SymbolicPi), + {static_cast(IntrinsicElementalFunctions::SymbolicPi), "pi"}, - {static_cast(IntrinsicScalarFunctions::SymbolicE), + {static_cast(IntrinsicElementalFunctions::SymbolicE), "E"}, - {static_cast(IntrinsicScalarFunctions::SymbolicInteger), + {static_cast(IntrinsicElementalFunctions::SymbolicInteger), "SymbolicInteger"}, - {static_cast(IntrinsicScalarFunctions::SymbolicDiff), + {static_cast(IntrinsicElementalFunctions::SymbolicDiff), "SymbolicDiff"}, - {static_cast(IntrinsicScalarFunctions::SymbolicExpand), + {static_cast(IntrinsicElementalFunctions::SymbolicExpand), "SymbolicExpand"}, - {static_cast(IntrinsicScalarFunctions::SymbolicSin), + {static_cast(IntrinsicElementalFunctions::SymbolicSin), "SymbolicSin"}, - {static_cast(IntrinsicScalarFunctions::SymbolicCos), + {static_cast(IntrinsicElementalFunctions::SymbolicCos), "SymbolicCos"}, - {static_cast(IntrinsicScalarFunctions::SymbolicLog), + {static_cast(IntrinsicElementalFunctions::SymbolicLog), "SymbolicLog"}, - {static_cast(IntrinsicScalarFunctions::SymbolicExp), + {static_cast(IntrinsicElementalFunctions::SymbolicExp), "SymbolicExp"}, - {static_cast(IntrinsicScalarFunctions::SymbolicAbs), + {static_cast(IntrinsicElementalFunctions::SymbolicAbs), "SymbolicAbs"}, - {static_cast(IntrinsicScalarFunctions::SymbolicHasSymbolQ), + {static_cast(IntrinsicElementalFunctions::SymbolicHasSymbolQ), "SymbolicHasSymbolQ"}, - {static_cast(IntrinsicScalarFunctions::SymbolicAddQ), + {static_cast(IntrinsicElementalFunctions::SymbolicAddQ), "SymbolicAddQ"}, - {static_cast(IntrinsicScalarFunctions::SymbolicMulQ), + {static_cast(IntrinsicElementalFunctions::SymbolicMulQ), "SymbolicMulQ"}, - {static_cast(IntrinsicScalarFunctions::SymbolicPowQ), + {static_cast(IntrinsicElementalFunctions::SymbolicPowQ), "SymbolicPowQ"}, - {static_cast(IntrinsicScalarFunctions::SymbolicLogQ), + {static_cast(IntrinsicElementalFunctions::SymbolicLogQ), "SymbolicLogQ"}, - {static_cast(IntrinsicScalarFunctions::SymbolicSinQ), + {static_cast(IntrinsicElementalFunctions::SymbolicSinQ), "SymbolicSinQ"}, - {static_cast(IntrinsicScalarFunctions::SymbolicGetArgument), + {static_cast(IntrinsicElementalFunctions::SymbolicGetArgument), "SymbolicGetArgument"}, }; @@ -3881,7 +733,13 @@ namespace IntrinsicScalarFunctionRegistry { static const std::map>& intrinsic_function_by_name_db = { - {"log_gamma", {&LogGamma::create_LogGamma, &LogGamma::eval_log_gamma}}, + {"type", {&ObjectType::create_ObjectType, &ObjectType::eval_ObjectType}}, + {"gamma", {&Gamma::create_Gamma, &Gamma::eval_Gamma}}, + {"log", {&Log::create_Log, &Log::eval_Log}}, + {"log10", {&Log10::create_Log10, &Log10::eval_Log10}}, + {"log_gamma", {&LogGamma::create_LogGamma, &LogGamma::eval_LogGamma}}, + {"erf", {&Erf::create_Erf, &Erf::eval_Erf}}, + {"erfc", {&Erfc::create_Erfc, &Erfc::eval_Erfc}}, {"trunc", {&Trunc::create_Trunc, &Trunc::eval_Trunc}}, {"fix", {&Fix::create_Fix, &Fix::eval_Fix}}, {"sin", {&Sin::create_Sin, &Sin::eval_Sin}}, @@ -3894,7 +752,11 @@ namespace IntrinsicScalarFunctionRegistry { {"cosh", {&Cosh::create_Cosh, &Cosh::eval_Cosh}}, {"tanh", {&Tanh::create_Tanh, &Tanh::eval_Tanh}}, {"atan2", {&Atan2::create_Atan2, &Atan2::eval_Atan2}}, + {"asinh", {&Asinh::create_Asinh, &Asinh::eval_Asinh}}, + {"acosh", {&Acosh::create_Acosh, &Acosh::eval_Acosh}}, + {"atanh", {&Atanh::create_Atanh, &Atanh::eval_Atanh}}, {"abs", {&Abs::create_Abs, &Abs::eval_Abs}}, + {"aimag", {&Aimag::create_Aimag, &Aimag::eval_Aimag}}, {"exp", {&Exp::create_Exp, &Exp::eval_Exp}}, {"exp2", {&Exp2::create_Exp2, &Exp2::eval_Exp2}}, {"expm1", {&Expm1::create_Expm1, &Expm1::eval_Expm1}}, @@ -3902,22 +764,92 @@ namespace IntrinsicScalarFunctionRegistry { {"floordiv", {&FloorDiv::create_FloorDiv, &FloorDiv::eval_FloorDiv}}, {"mod", {&Mod::create_Mod, &Mod::eval_Mod}}, {"trailz", {&Trailz::create_Trailz, &Trailz::eval_Trailz}}, + {"bessel_j0", {&BesselJ0::create_BesselJ0, &BesselJ0::eval_BesselJ0}}, + {"bessel_j1", {&BesselJ1::create_BesselJ1, &BesselJ1::eval_BesselJ1}}, + {"bessel_y0", {&BesselY0::create_BesselY0, &BesselY0::eval_BesselY0}}, + {"mvbits", {&Mvbits::create_Mvbits, &Mvbits::eval_Mvbits}}, + {"shiftr", {&Shiftr::create_Shiftr, &Shiftr::eval_Shiftr}}, + {"rshift", {&Rshift::create_Rshift, &Rshift::eval_Rshift}}, + {"shiftl", {&Shiftl::create_Shiftl, &Shiftl::eval_Shiftl}}, + {"lshift", {&Shiftl::create_Shiftl, &Shiftl::eval_Shiftl}}, + {"dshiftl", {&Dshiftl::create_Dshiftl, &Dshiftl::eval_Dshiftl}}, + {"ishft", {&Ishft::create_Ishft, &Ishft::eval_Ishft}}, + {"bgt", {&Bgt::create_Bgt, &Bgt::eval_Bgt}}, + {"blt", {&Blt::create_Blt, &Blt::eval_Blt}}, + {"bge", {&Bge::create_Bge, &Bge::eval_Bge}}, + {"ble", {&Ble::create_Ble, &Ble::eval_Ble}}, + {"lgt", {&Lgt::create_Lgt, &Lgt::eval_Lgt}}, + {"llt", {&Llt::create_Llt, &Llt::eval_Llt}}, + {"lge", {&Lge::create_Lge, &Lge::eval_Lge}}, + {"lle", {&Lle::create_Lle, &Lle::eval_Lle}}, + {"exponent", {&Exponent::create_Exponent, &Exponent::eval_Exponent}}, + {"fraction", {&Fraction::create_Fraction, &Fraction::eval_Fraction}}, + {"set_exponent", {&SetExponent::create_SetExponent, &SetExponent::eval_SetExponent}}, + {"not", {&Not::create_Not, &Not::eval_Not}}, + {"iand", {&Iand::create_Iand, &Iand::eval_Iand}}, + {"ior", {&Ior::create_Ior, &Ior::eval_Ior}}, + {"ieor", {&Ieor::create_Ieor, &Ieor::eval_Ieor}}, + {"ibclr", {&Ibclr::create_Ibclr, &Ibclr::eval_Ibclr}}, + {"ibset", {&Ibset::create_Ibset, &Ibset::eval_Ibset}}, + {"btest", {&Btest::create_Btest, &Btest::eval_Btest}}, + {"ibits", {&Ibits::create_Ibits, &Ibits::eval_Ibits}}, + {"leadz", {&Leadz::create_Leadz, &Leadz::eval_Leadz}}, + {"_lfortran_tolowercase", {&ToLowerCase::create_ToLowerCase, &ToLowerCase::eval_ToLowerCase}}, + {"hypot", {&Hypot::create_Hypot, &Hypot::eval_Hypot}}, + {"selected_int_kind", {&SelectedIntKind::create_SelectedIntKind, &SelectedIntKind::eval_SelectedIntKind}}, + {"selected_real_kind", {&SelectedRealKind::create_SelectedRealKind, &SelectedRealKind::eval_SelectedRealKind}}, + {"selected_char_kind", {&SelectedCharKind::create_SelectedCharKind, &SelectedCharKind::eval_SelectedCharKind}}, + {"kind", {&Kind::create_Kind, &Kind::eval_Kind}}, + {"rank", {&Rank::create_Rank, &Rank::eval_Rank}}, + {"digits", {&Digits::create_Digits, &Digits::eval_Digits}}, + {"rrspacing", {&Rrspacing::create_Rrspacing, &Rrspacing::eval_Rrspacing}}, + {"repeat", {&Repeat::create_Repeat, &Repeat::eval_Repeat}}, + {"verify", {&StringContainsSet::create_StringContainsSet, &StringContainsSet::eval_StringContainsSet}}, + {"scan", {&StringFindSet::create_StringFindSet, &StringFindSet::eval_StringFindSet}}, + {"index", {&SubstrIndex::create_SubstrIndex, &SubstrIndex::eval_SubstrIndex}}, + {"minexponent", {&MinExponent::create_MinExponent, &MinExponent::eval_MinExponent}}, + {"maxexponent", {&MaxExponent::create_MaxExponent, &MaxExponent::eval_MaxExponent}}, {"list.index", {&ListIndex::create_ListIndex, &ListIndex::eval_list_index}}, - {"list.reverse", {&ListReverse::create_ListReverse, &ListReverse::eval_list_reverse}}, + {"list.reverse", {&ListReverse::create_ListReverse, &ListReverse::eval_ListReverse}}, {"list.pop", {&ListPop::create_ListPop, &ListPop::eval_list_pop}}, - {"reserve", {&Reserve::create_Reserve, &Reserve::eval_reserve}}, + {"list.reserve", {&ListReserve::create_ListReserve, &ListReserve::eval_ListReserve}}, {"dict.keys", {&DictKeys::create_DictKeys, &DictKeys::eval_dict_keys}}, {"dict.values", {&DictValues::create_DictValues, &DictValues::eval_dict_values}}, {"set.add", {&SetAdd::create_SetAdd, &SetAdd::eval_set_add}}, {"set.remove", {&SetRemove::create_SetRemove, &SetRemove::eval_set_remove}}, {"max0", {&Max::create_Max, &Max::eval_Max}}, + {"adjustl", {&Adjustl::create_Adjustl, &Adjustl::eval_Adjustl}}, + {"adjustr", {&Adjustr::create_Adjustr, &Adjustr::eval_Adjustr}}, + {"ichar", {&Ichar::create_Ichar, &Ichar::eval_Ichar}}, + {"char", {&Char::create_Char, &Char::eval_Char}}, {"min0", {&Min::create_Min, &Min::eval_Min}}, + {"max", {&Max::create_Max, &Max::eval_Max}}, {"min", {&Min::create_Min, &Min::eval_Min}}, - {"radix", {&Radix::create_Radix, nullptr}}, + {"ishftc", {&Ishftc::create_Ishftc, &Ishftc::eval_Ishftc}}, + {"radix", {&Radix::create_Radix, &Radix::eval_Radix}}, + {"scale", {&Scale::create_Scale, &Scale::eval_Scale}}, + {"dprod", {&Dprod::create_Dprod, &Dprod::eval_Dprod}}, + {"range", {&Range::create_Range, &Range::eval_Range}}, {"sign", {&Sign::create_Sign, &Sign::eval_Sign}}, {"aint", {&Aint::create_Aint, &Aint::eval_Aint}}, + {"popcnt", {&Popcnt::create_Popcnt, &Popcnt::eval_Popcnt}}, + {"poppar", {&Poppar::create_Poppar, &Poppar::eval_Poppar}}, + {"nint", {&Nint::create_Nint, &Nint::eval_Nint}}, + {"anint", {&Anint::create_Anint, &Anint::eval_Anint}}, + {"dim", {&Dim::create_Dim, &Dim::eval_Dim}}, + {"floor", {&Floor::create_Floor, &Floor::eval_Floor}}, + {"ceiling", {&Ceiling::create_Ceiling, &Ceiling::eval_Ceiling}}, + {"maskr", {&Maskr::create_Maskr, &Maskr::eval_Maskr}}, + {"maskl", {&Maskl::create_Maskl, &Maskl::eval_Maskl}}, {"sqrt", {&Sqrt::create_Sqrt, &Sqrt::eval_Sqrt}}, {"sngl", {&Sngl::create_Sngl, &Sngl::eval_Sngl}}, + {"ifix", {&Ifix::create_Ifix, &Ifix::eval_Ifix}}, + {"idint", {&Idint::create_Idint, &Idint::eval_Idint}}, + {"epsilon", {&Epsilon::create_Epsilon, &Epsilon::eval_Epsilon}}, + {"precision", {&Precision::create_Precision, &Precision::eval_Precision}}, + {"tiny", {&Tiny::create_Tiny, &Tiny::eval_Tiny}}, + {"conjg", {&Conjg::create_Conjg, &Conjg::eval_Conjg}}, + {"huge", {&Huge::create_Huge, &Huge::eval_Huge}}, {"Symbol", {&SymbolicSymbol::create_SymbolicSymbol, &SymbolicSymbol::eval_SymbolicSymbol}}, {"SymbolicAdd", {&SymbolicAdd::create_SymbolicAdd, &SymbolicAdd::eval_SymbolicAdd}}, {"SymbolicSub", {&SymbolicSub::create_SymbolicSub, &SymbolicSub::eval_SymbolicSub}}, @@ -3951,24 +883,6 @@ namespace IntrinsicScalarFunctionRegistry { return intrinsic_function_by_id_db.find(id) != intrinsic_function_by_id_db.end(); } - static inline bool is_elemental(int64_t id) { - IntrinsicScalarFunctions id_ = static_cast(id); - return ( id_ == IntrinsicScalarFunctions::Abs || - id_ == IntrinsicScalarFunctions::Cos || - id_ == IntrinsicScalarFunctions::Gamma || - id_ == IntrinsicScalarFunctions::LogGamma || - id_ == IntrinsicScalarFunctions::Trunc || - id_ == IntrinsicScalarFunctions::Fix || - id_ == IntrinsicScalarFunctions::Sin || - id_ == IntrinsicScalarFunctions::Exp || - id_ == IntrinsicScalarFunctions::Exp2 || - id_ == IntrinsicScalarFunctions::Expm1 || - id_ == IntrinsicScalarFunctions::Min || - id_ == IntrinsicScalarFunctions::Max || - id_ == IntrinsicScalarFunctions::Sqrt || - id_ == IntrinsicScalarFunctions::SymbolicSymbol); - } - static inline create_intrinsic_function get_create_function(const std::string& name) { return std::get<0>(intrinsic_function_by_name_db.at(name)); } @@ -3992,21 +906,13 @@ namespace IntrinsicScalarFunctionRegistry { return intrinsic_function_id_to_name.at(id); } - static inline bool is_input_type_supported(const std::string& name, Vec& args) { - if( name == "exp" ) { - if( !ASRUtils::is_real(*ASRUtils::expr_type(args[0])) ) { - return false; - } - } - return true; - } - -} // namespace IntrinsicScalarFunctionRegistry +} // namespace IntrinsicElementalFunctionRegistry /************************* Intrinsic Impure Function **************************/ enum class IntrinsicImpureFunctions : int64_t { IsIostatEnd, IsIostatEor, + Allocated, // ... }; @@ -4014,7 +920,7 @@ namespace IsIostatEnd { static inline ASR::asr_t* create_IsIostatEnd(Allocator& al, const Location& loc, Vec& args, - const std::function /*err*/) { + diag::Diagnostics& /*diag*/) { // Compile time value cannot be computed return ASR::make_IntrinsicImpureFunction_t(al, loc, static_cast(ASRUtils::IntrinsicImpureFunctions::IsIostatEnd), @@ -4023,11 +929,33 @@ namespace IsIostatEnd { } // namespace IsIostatEnd +namespace Allocated { + + static inline ASR::asr_t* create_Allocated(Allocator& al, const Location& loc, + Vec& args, diag::Diagnostics& diag) { + // Compile time value cannot be computed + if( args.n != 1 ) { + append_error(diag, "Intrinsic `allocated` accepts exactly one argument", \ + loc); \ + return nullptr; + } + if( !ASRUtils::is_allocatable(args.p[0]) ) { + append_error(diag, "Intrinsic `allocated` can be called only on" \ + " allocatable argument", loc); + return nullptr; + } + return ASR::make_IntrinsicImpureFunction_t(al, loc, + static_cast(ASRUtils::IntrinsicImpureFunctions::Allocated), + args.p, args.n, 0, logical, nullptr); + } + +} // namespace Allocated + namespace IsIostatEor { static inline ASR::asr_t* create_IsIostatEor(Allocator& al, const Location& loc, Vec& args, - const std::function /*err*/) { + diag::Diagnostics& /*diag*/) { // Compile time value cannot be computed return ASR::make_IntrinsicImpureFunction_t(al, loc, static_cast(ASRUtils::IntrinsicImpureFunctions::IsIostatEor), @@ -4042,6 +970,7 @@ namespace IntrinsicImpureFunctionRegistry { eval_intrinsic_function>>& function_by_name_db = { {"is_iostat_end", {&IsIostatEnd::create_IsIostatEnd, nullptr}}, {"is_iostat_eor", {&IsIostatEor::create_IsIostatEor, nullptr}}, + {"allocated", {&Allocated::create_Allocated, nullptr}}, }; static inline bool is_intrinsic_function(const std::string& name) { @@ -4064,6 +993,7 @@ inline std::string get_impure_intrinsic_name(int x) { switch (x) { IMPURE_INTRINSIC_NAME_CASE(IsIostatEnd) IMPURE_INTRINSIC_NAME_CASE(IsIostatEor) + IMPURE_INTRINSIC_NAME_CASE(Allocated) default : { throw LCompilersException("pickle: intrinsic_id not implemented"); } diff --git a/src/libasr/pass/intrinsic_function_registry_util.h b/src/libasr/pass/intrinsic_function_registry_util.h new file mode 100644 index 0000000..f8b6017 --- /dev/null +++ b/src/libasr/pass/intrinsic_function_registry_util.h @@ -0,0 +1,3555 @@ +#ifndef LIBASR_PASS_INTRINSIC_FUNC_REG_UTIL_H +#define LIBASR_PASS_INTRINSIC_FUNC_REG_UTIL_H + +#include + +namespace LCompilers { + +namespace ASRUtils { + +namespace Kind { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Kind expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)) || (is_real(*arg_type0)) || (is_logical(*arg_type0)) || (is_character(*arg_type0)) || (is_complex(*arg_type0)), "Unexpected args, Kind expects (int) or (real) or (bool) or (char) or (complex) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Kind takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(is_integer(*x.m_type), "Unexpected return type, Kind expects `int` as return type", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Kind(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)) || (is_real(*arg_type0)) || (is_logical(*arg_type0)) || (is_character(*arg_type0)) || (is_complex(*arg_type0)))) { + append_error(diag, "Unexpected args, Kind expects (int) or (real) or (bool) or (char) or (complex) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Kind takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Kind(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Kind), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace FMA { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 3) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for FMA expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASRUtils::require_impl((is_real(*arg_type0) && is_real(*arg_type1) && is_real(*arg_type2)), "Unexpected args, FMA expects (real, real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, FMA takes 3 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_FMA(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 3) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + if(!((is_real(*arg_type0) && is_real(*arg_type1) && is_real(*arg_type2)))) { + append_error(diag, "Unexpected args, FMA expects (real, real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, FMA takes 3 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 3); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 3); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + m_value = eval_FMA(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::FMA), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace FlipSign { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for FlipSign expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_real(*arg_type1)), "Unexpected args, FlipSign expects (int, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, FlipSign takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_FlipSign(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, FlipSign expects (int, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, FlipSign takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[1])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_FlipSign(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::FlipSign), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace FloorDiv { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for FloorDiv expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_unsigned_integer(*arg_type0) && is_unsigned_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)) || (is_logical(*arg_type0) && is_logical(*arg_type1)), "Unexpected args, FloorDiv expects (int, int) or (uint, uint) or (real, real) or (bool, bool) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, FloorDiv takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_FloorDiv(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_unsigned_integer(*arg_type0) && is_unsigned_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)) || (is_logical(*arg_type0) && is_logical(*arg_type1)))) { + append_error(diag, "Unexpected args, FloorDiv expects (int, int) or (uint, uint) or (real, real) or (bool, bool) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, FloorDiv takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_FloorDiv(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::FloorDiv), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Mod { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Mod expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)), "Unexpected args, Mod expects (int, int) or (real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Mod takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Mod(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, Mod expects (int, int) or (real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Mod takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Mod(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Mod), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Trailz { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Trailz expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Trailz expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Trailz takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Trailz(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Trailz expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Trailz takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Trailz(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Trailz), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace BesselJ0 { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for BesselJ0 expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, BesselJ0 expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, BesselJ0 takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_BesselJ0(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, BesselJ0 expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, BesselJ0 takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_BesselJ0(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::BesselJ0), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace BesselJ1 { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for BesselJ1 expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, BesselJ1 expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, BesselJ1 takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_BesselJ1(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, BesselJ1 expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, BesselJ1 takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_BesselJ1(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::BesselJ1), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace BesselY0 { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for BesselY0 expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, BesselY0 expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, BesselY0 takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_BesselY0(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, BesselY0 expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, BesselY0 takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_BesselY0(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::BesselY0), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Mvbits { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 5) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Mvbits expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[3])); + ASR::ttype_t *arg_type4 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[4])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2) && is_integer(*arg_type3) && is_integer(*arg_type4)), "Unexpected args, Mvbits expects (int, int, int, int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Mvbits takes 5 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Mvbits(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 5) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[3])); + ASR::ttype_t *arg_type4 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[4])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2) && is_integer(*arg_type3) && is_integer(*arg_type4)))) { + append_error(diag, "Unexpected args, Mvbits expects (int, int, int, int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Mvbits takes 5 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[3])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 5); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + m_args.push_back(al, args[3]); + m_args.push_back(al, args[4]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 5); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + args_values.push_back(al, expr_value(m_args[3])); + args_values.push_back(al, expr_value(m_args[4])); + m_value = eval_Mvbits(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Mvbits), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Leadz { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Leadz expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Leadz expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Leadz takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Leadz(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Leadz expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Leadz takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Leadz(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Leadz), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace ToLowerCase { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for ToLowerCase expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_character(*arg_type0)), "Unexpected args, ToLowerCase expects (char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, ToLowerCase takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_ToLowerCase(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_character(*arg_type0)))) { + append_error(diag, "Unexpected args, ToLowerCase expects (char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, ToLowerCase takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_ToLowerCase(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::ToLowerCase), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Hypot { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Hypot expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_real(*arg_type0) && is_real(*arg_type1)), "Unexpected args, Hypot expects (real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Hypot takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Hypot(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_real(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, Hypot expects (real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Hypot takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Hypot(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Hypot), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace SelectedIntKind { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for SelectedIntKind expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, SelectedIntKind expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, SelectedIntKind takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_SelectedIntKind(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, SelectedIntKind expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, SelectedIntKind takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_SelectedIntKind(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::SelectedIntKind), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace SelectedRealKind { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 3) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for SelectedRealKind expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2)), "Unexpected args, SelectedRealKind expects (int, int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, SelectedRealKind takes 3 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_SelectedRealKind(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 3) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2)))) { + append_error(diag, "Unexpected args, SelectedRealKind expects (int, int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, SelectedRealKind takes 3 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 3); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 3); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + m_value = eval_SelectedRealKind(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::SelectedRealKind), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace SelectedCharKind { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for SelectedCharKind expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_character(*arg_type0)), "Unexpected args, SelectedCharKind expects (char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, SelectedCharKind takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_SelectedCharKind(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_character(*arg_type0)))) { + append_error(diag, "Unexpected args, SelectedCharKind expects (char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, SelectedCharKind takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_SelectedCharKind(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::SelectedCharKind), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Digits { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Digits expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)) || (is_real(*arg_type0)), "Unexpected args, Digits expects (int) or (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Digits takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Digits(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)) || (is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Digits expects (int) or (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Digits takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Digits(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Digits), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Repeat { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Repeat expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_character(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Repeat expects (char, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Repeat takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Repeat(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_character(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Repeat expects (char, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Repeat takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Repeat(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Repeat), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace StringContainsSet { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 4) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for StringContainsSet expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[3])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1) && is_logical(*arg_type2) && is_integer(*arg_type3)), "Unexpected args, StringContainsSet expects (char, char, bool, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, StringContainsSet takes 4 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_StringContainsSet(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 4) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[3])); + if(!((is_character(*arg_type0) && is_character(*arg_type1) && is_logical(*arg_type2) && is_integer(*arg_type3)))) { + append_error(diag, "Unexpected args, StringContainsSet expects (char, char, bool, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, StringContainsSet takes 4 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[3])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 4); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + m_args.push_back(al, args[3]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 4); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + args_values.push_back(al, expr_value(m_args[3])); + m_value = eval_StringContainsSet(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::StringContainsSet), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace StringFindSet { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 4) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for StringFindSet expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[3])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1) && is_logical(*arg_type2) && is_integer(*arg_type3)), "Unexpected args, StringFindSet expects (char, char, bool, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, StringFindSet takes 4 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_StringFindSet(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 4) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[3])); + if(!((is_character(*arg_type0) && is_character(*arg_type1) && is_logical(*arg_type2) && is_integer(*arg_type3)))) { + append_error(diag, "Unexpected args, StringFindSet expects (char, char, bool, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, StringFindSet takes 4 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[3])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 4); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + m_args.push_back(al, args[3]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 4); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + args_values.push_back(al, expr_value(m_args[3])); + m_value = eval_StringFindSet(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::StringFindSet), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace SubstrIndex { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 4) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for SubstrIndex expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[3])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1) && is_logical(*arg_type2) && is_integer(*arg_type3)), "Unexpected args, SubstrIndex expects (char, char, bool, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, SubstrIndex takes 4 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_SubstrIndex(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 4) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + ASR::ttype_t *arg_type3 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[3])); + if(!((is_character(*arg_type0) && is_character(*arg_type1) && is_logical(*arg_type2) && is_integer(*arg_type3)))) { + append_error(diag, "Unexpected args, SubstrIndex expects (char, char, bool, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, SubstrIndex takes 4 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[3])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 4); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + m_args.push_back(al, args[3]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 4); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + args_values.push_back(al, expr_value(m_args[3])); + m_value = eval_SubstrIndex(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::SubstrIndex), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace MinExponent { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for MinExponent expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, MinExponent expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, MinExponent takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_MinExponent(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, MinExponent expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, MinExponent takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_MinExponent(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::MinExponent), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace MaxExponent { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for MaxExponent expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, MaxExponent expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, MaxExponent takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_MaxExponent(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, MaxExponent expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, MaxExponent takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_MaxExponent(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::MaxExponent), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Partition { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Partition expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1)), "Unexpected args, Partition expects (char, char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Partition takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(ASR::is_a(*x.m_type), "Unexpected return type, Partition expects `tuple` as return type", x.base.base.loc, diagnostics); + } + +} + +namespace ListReverse { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for ListReverse expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((ASR::is_a(*arg_type0)), "Unexpected args, ListReverse expects (list) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, ListReverse takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_type == nullptr, "Unexpected return type, ListReverse expects `null` as return type", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_ListReverse(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((ASR::is_a(*arg_type0)))) { + append_error(diag, "Unexpected args, ListReverse expects (list) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, ListReverse takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = nullptr; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_ListReverse(al, loc, return_type, args_values, diag); + } + return ASR::make_Expr_t(al, loc, ASRUtils::EXPR(ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::ListReverse), m_args.p, m_args.n, 0, return_type, m_value))); + } +} + +namespace ListReserve { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for ListReserve expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((ASR::is_a(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, ListReserve expects (list, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, ListReserve takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_type == nullptr, "Unexpected return type, ListReserve expects `null` as return type", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_ListReserve(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((ASR::is_a(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, ListReserve expects (list, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, ListReserve takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = nullptr; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_ListReserve(al, loc, return_type, args_values, diag); + } + return ASR::make_Expr_t(al, loc, ASRUtils::EXPR(ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::ListReserve), m_args.p, m_args.n, 0, return_type, m_value))); + } +} + +namespace Sign { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Sign expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)), "Unexpected args, Sign expects (int, int) or (real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Sign takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Sign(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, Sign expects (int, int) or (real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Sign takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Sign(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Sign), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Radix { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Radix expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)) || (is_real(*arg_type0)), "Unexpected args, Radix expects (int) or (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Radix takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Radix` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + ASRUtils::require_impl(is_integer(*x.m_type), "Unexpected return type, Radix expects `int` as return type", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Radix(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)) || (is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Radix expects (int) or (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Radix takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Radix(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Radix), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Adjustl { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Adjustl expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_character(*arg_type0)), "Unexpected args, Adjustl expects (char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Adjustl takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Adjustl(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_character(*arg_type0)))) { + append_error(diag, "Unexpected args, Adjustl expects (char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Adjustl takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = character(-1); + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Adjustl(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Adjustl), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Adjustr { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Adjustr expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_character(*arg_type0)), "Unexpected args, Adjustr expects (char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Adjustr takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Adjustr(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_character(*arg_type0)))) { + append_error(diag, "Unexpected args, Adjustr expects (char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Adjustr takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = character(-1); + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Adjustr(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Adjustr), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Aint { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Aint expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Aint expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Aint takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Aint(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Aint expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Aint takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Aint` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Aint(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Aint), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Nint { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Nint expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Nint expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Nint takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Nint(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Nint expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Nint takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Nint` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Nint(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Nint), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Anint { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Anint expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Anint expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Anint takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Anint(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Anint expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Anint takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Anint` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Anint(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Anint), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Floor { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Floor expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Floor expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Floor takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Floor(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Floor expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Floor takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Floor` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Floor(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Floor), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ceiling { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ceiling expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Ceiling expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ceiling takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ceiling(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Ceiling expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ceiling takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Ceiling` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Ceiling(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ceiling), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Sqrt { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Sqrt expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)) || (is_complex(*arg_type0)), "Unexpected args, Sqrt expects (real) or (complex) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Sqrt takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Sqrt(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)) || (is_complex(*arg_type0)))) { + append_error(diag, "Unexpected args, Sqrt expects (real) or (complex) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Sqrt takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Sqrt(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Sqrt), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Sngl { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Sngl expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Sngl expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Sngl takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Sngl(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Sngl expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Sngl takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = real32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Sngl(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Sngl), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace SignFromValue { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for SignFromValue expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)), "Unexpected args, SignFromValue expects (int, int) or (real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, SignFromValue takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_SignFromValue(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, SignFromValue expects (int, int) or (real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, SignFromValue takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_SignFromValue(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::SignFromValue), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ifix { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ifix expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Ifix expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ifix takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ifix(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Ifix expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ifix takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Ifix(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ifix), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Idint { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Idint expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Idint expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Idint takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Idint(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Idint expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Idint takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Idint(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Idint), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ishft { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ishft expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ishft expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ishft takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ishft(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ishft expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ishft takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ishft(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ishft), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Bgt { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Bgt expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Bgt expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Bgt takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Bgt(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Bgt expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Bgt takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Bgt(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Bgt), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Blt { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Blt expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Blt expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Blt takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Blt(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Blt expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Blt takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Blt(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Blt), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Bge { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Bge expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Bge expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Bge takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Bge(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Bge expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Bge takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Bge(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Bge), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ble { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ble expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ble expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ble takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ble(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ble expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ble takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ble(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ble), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Lgt { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Lgt expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1)), "Unexpected args, Lgt expects (char, char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Lgt takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Lgt(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_character(*arg_type0) && is_character(*arg_type1)))) { + append_error(diag, "Unexpected args, Lgt expects (char, char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Lgt takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Lgt(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Lgt), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Llt { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Llt expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1)), "Unexpected args, Llt expects (char, char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Llt takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Llt(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_character(*arg_type0) && is_character(*arg_type1)))) { + append_error(diag, "Unexpected args, Llt expects (char, char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Llt takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Llt(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Llt), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Lge { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Lge expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1)), "Unexpected args, Lge expects (char, char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Lge takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Lge(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_character(*arg_type0) && is_character(*arg_type1)))) { + append_error(diag, "Unexpected args, Lge expects (char, char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Lge takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Lge(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Lge), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Lle { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Lle expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_character(*arg_type0) && is_character(*arg_type1)), "Unexpected args, Lle expects (char, char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Lle takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Lle(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_character(*arg_type0) && is_character(*arg_type1)))) { + append_error(diag, "Unexpected args, Lle expects (char, char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Lle takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Lle(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Lle), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Not { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Not expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Not expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Not takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Not(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Not expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Not takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Not(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Not), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Iand { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Iand expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Iand expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Iand takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Iand(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Iand expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Iand takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Iand(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Iand), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ior { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ior expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ior expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ior takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ior(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ior expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ior takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ior(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ior), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ieor { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ieor expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ieor expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ieor takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ieor(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ieor expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ieor takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ieor(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ieor), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ibclr { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ibclr expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ibclr expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ibclr takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ibclr(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ibclr expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ibclr takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ibclr(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ibclr), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ibset { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ibset expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ibset expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ibset takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ibset(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ibset expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ibset takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ibset(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ibset), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Btest { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Btest expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Btest expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Btest takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Btest(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Btest expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Btest takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = logical; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Btest(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Btest), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ibits { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 3) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ibits expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2)), "Unexpected args, Ibits expects (int, int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ibits takes 3 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ibits(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 3) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2)))) { + append_error(diag, "Unexpected args, Ibits expects (int, int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ibits takes 3 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 3); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 3); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + m_value = eval_Ibits(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ibits), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Shiftr { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Shiftr expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Shiftr expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Shiftr takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Shiftr(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Shiftr expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Shiftr takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Shiftr(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Shiftr), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Rshift { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Rshift expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Rshift expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Rshift takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Rshift(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Rshift expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Rshift takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Rshift(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Rshift), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Shiftl { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Shiftl expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Shiftl expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Shiftl takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Shiftl(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Shiftl expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Shiftl takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Shiftl(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Shiftl), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Aimag { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Aimag expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_complex(*arg_type0)), "Unexpected args, Aimag expects (complex) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Aimag takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Aimag(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_complex(*arg_type0)))) { + append_error(diag, "Unexpected args, Aimag expects (complex) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Aimag takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = real32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Aimag` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Aimag(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Aimag), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Rank { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Rank expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((!ASR::is_a(*arg_type0)), "Unexpected args, Rank expects (any) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Rank takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Rank` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Rank(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((!ASR::is_a(*arg_type0)))) { + append_error(diag, "Unexpected args, Rank expects (any) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Rank takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Rank(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Rank), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Range { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Range expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)) || (is_real(*arg_type0)) || (is_complex(*arg_type0)), "Unexpected args, Range expects (int) or (real) or (complex) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Range takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Range` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Range(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)) || (is_real(*arg_type0)) || (is_complex(*arg_type0)))) { + append_error(diag, "Unexpected args, Range expects (int) or (real) or (complex) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Range takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Range(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Range), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Epsilon { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Epsilon expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Epsilon expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Epsilon takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Epsilon` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Epsilon(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Epsilon expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Epsilon takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Epsilon(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Epsilon), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Precision { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Precision expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)) || (is_complex(*arg_type0)), "Unexpected args, Precision expects (real) or (complex) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Precision takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Precision` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Precision(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)) || (is_complex(*arg_type0)))) { + append_error(diag, "Unexpected args, Precision expects (real) or (complex) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Precision takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Precision(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Precision), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Tiny { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Tiny expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Tiny expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Tiny takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Tiny` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Tiny(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Tiny expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Tiny takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Tiny(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Tiny), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Conjg { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Conjg expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_complex(*arg_type0)), "Unexpected args, Conjg expects (complex) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Conjg takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Conjg(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_complex(*arg_type0)))) { + append_error(diag, "Unexpected args, Conjg expects (complex) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Conjg takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Conjg(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Conjg), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Scale { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Scale expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_real(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Scale expects (real, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Scale takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Scale(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_real(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Scale expects (real, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Scale takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Scale(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Scale), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Huge { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Huge expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)) || (is_real(*arg_type0)), "Unexpected args, Huge expects (int) or (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Huge takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(x.m_value, "Missing compile time value, `Huge` intrinsic output must be computed during compile time", x.base.base.loc, diagnostics); + } + + static inline ASR::asr_t* create_Huge(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)) || (is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Huge expects (int) or (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Huge takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + return_type = ASRUtils::extract_type(return_type); + m_value = eval_Huge(al, loc, return_type, args, diag); + return ASR::make_TypeInquiry_t(al, loc, static_cast(IntrinsicElementalFunctions::Huge), ASRUtils::expr_type(m_args[0]), m_args[0], return_type, m_value); + } +} + +namespace Dprod { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Dprod expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_real(*arg_type0) && is_real(*arg_type1)), "Unexpected args, Dprod expects (real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Dprod takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Dprod(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_real(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, Dprod expects (real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Dprod takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = real64; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Dprod(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Dprod), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Dim { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Dim expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)), "Unexpected args, Dim expects (int, int) or (real, real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Dim takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Dim(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)) || (is_real(*arg_type0) && is_real(*arg_type1)))) { + append_error(diag, "Unexpected args, Dim expects (int, int) or (real, real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Dim takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Dim(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Dim), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Maskl { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Maskl expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Maskl expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Maskl takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Maskl(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Maskl expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Maskl takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Maskl` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Maskl(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Maskl), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Maskr { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Maskr expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Maskr expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Maskr takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Maskr(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Maskr expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Maskr takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Maskr` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Maskr(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Maskr), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ishftc { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ishftc expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, Ishftc expects (int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ishftc takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ishftc(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, Ishftc expects (int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ishftc takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_Ishftc(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ishftc), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Ichar { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Ichar expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_character(*arg_type0)), "Unexpected args, Ichar expects (char) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Ichar takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Ichar(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_character(*arg_type0)))) { + append_error(diag, "Unexpected args, Ichar expects (char) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Ichar takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Ichar` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Ichar(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Ichar), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Char { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Char expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Char expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Char takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Char(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Char expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Char takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = character(1); + if ( args[1] != nullptr ) { + int kind = -1; + if (!ASR::is_a(*expr_type(args[1])) || !extract_value(args[1], kind)) { + append_error(diag, "`kind` argument of the `Char` function must be a scalar Integer constant", args[1]->base.loc); + return nullptr; + } + set_kind_to_ttype_t(return_type, kind); + } + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Char(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Char), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Exponent { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Exponent expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Exponent expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Exponent takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Exponent(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Exponent expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Exponent takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Exponent(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Exponent), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Fraction { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Fraction expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Fraction expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Fraction takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Fraction(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Fraction expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Fraction takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Fraction(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Fraction), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace SetExponent { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 2) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for SetExponent expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASRUtils::require_impl((is_real(*arg_type0) && is_integer(*arg_type1)), "Unexpected args, SetExponent expects (real, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, SetExponent takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_SetExponent(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 2) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + if(!((is_real(*arg_type0) && is_integer(*arg_type1)))) { + append_error(diag, "Unexpected args, SetExponent expects (real, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, SetExponent takes 2 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 2); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 2); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + m_value = eval_SetExponent(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::SetExponent), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Rrspacing { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Rrspacing expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_real(*arg_type0)), "Unexpected args, Rrspacing expects (real) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Rrspacing takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Rrspacing(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_real(*arg_type0)))) { + append_error(diag, "Unexpected args, Rrspacing expects (real) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Rrspacing takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Rrspacing(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Rrspacing), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Dshiftl { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 3) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Dshiftl expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[2])); + ASRUtils::require_impl((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2)), "Unexpected args, Dshiftl expects (int, int, int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Dshiftl takes 3 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Dshiftl(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 3) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + ASR::ttype_t *arg_type1 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[1])); + ASR::ttype_t *arg_type2 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[2])); + if(!((is_integer(*arg_type0) && is_integer(*arg_type1) && is_integer(*arg_type2)))) { + append_error(diag, "Unexpected args, Dshiftl expects (int, int, int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Dshiftl takes 3 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASRUtils::ExprStmtDuplicator expr_duplicator(al); + expr_duplicator.allow_procedure_calls = true; + ASR::ttype_t* type_ = expr_duplicator.duplicate_ttype(expr_type(args[0])); + ASR::ttype_t *return_type = type_; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 3); + m_args.push_back(al, args[0]); + m_args.push_back(al, args[1]); + m_args.push_back(al, args[2]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 3); + args_values.push_back(al, expr_value(m_args[0])); + args_values.push_back(al, expr_value(m_args[1])); + args_values.push_back(al, expr_value(m_args[2])); + m_value = eval_Dshiftl(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Dshiftl), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Popcnt { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Popcnt expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Popcnt expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Popcnt takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Popcnt(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Popcnt expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Popcnt takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Popcnt(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Popcnt), m_args.p, m_args.n, 0, return_type, m_value); + } +} + +namespace Poppar { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for Poppar expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl((is_integer(*arg_type0)), "Unexpected args, Poppar expects (int) as arguments", x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, Poppar takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_Poppar(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& diag) { + if (args.size() == 1) { + ASR::ttype_t *arg_type0 = ASRUtils::type_get_past_const(ASRUtils::expr_type(args[0])); + if(!((is_integer(*arg_type0)))) { + append_error(diag, "Unexpected args, Poppar expects (int) as arguments", loc); + return nullptr; + } + } + else { + append_error(diag, "Unexpected number of args, Poppar takes 1 arguments, found " + std::to_string(args.size()), loc); + return nullptr; + } + ASR::ttype_t *return_type = int32; + ASR::expr_t *m_value = nullptr; + Vec m_args; m_args.reserve(al, 1); + m_args.push_back(al, args[0]); + if (all_args_evaluated(m_args)) { + Vec args_values; args_values.reserve(al, 1); + args_values.push_back(al, expr_value(m_args[0])); + m_value = eval_Poppar(al, loc, return_type, args_values, diag); + } + return ASR::make_IntrinsicElementalFunction_t(al, loc, static_cast(IntrinsicElementalFunctions::Poppar), m_args.p, m_args.n, 0, return_type, m_value); + } +} + + +} // namespace ASRUtil + +} // namespace LCompilers + +#endif // LIBASR_PASS_INTRINSIC_FUNC_REG_UTIL_H diff --git a/src/libasr/pass/intrinsic_functions.h b/src/libasr/pass/intrinsic_functions.h new file mode 100644 index 0000000..af48083 --- /dev/null +++ b/src/libasr/pass/intrinsic_functions.h @@ -0,0 +1,5765 @@ +#ifndef LIBASR_PASS_INTRINSIC_FUNCTIONS_H +#define LIBASR_PASS_INTRINSIC_FUNCTIONS_H + +#include +#include + +namespace LCompilers::ASRUtils { + +/* +To add a new function implementation, + +1. Create a new namespace like, `Sin`, `LogGamma` in this file. +2. In the above created namespace add `eval_*`, `instantiate_*`, and `create_*`. +3. Then register in the maps present in `IntrinsicElementalFunctionRegistry`. + +You can use helper macros and define your own helper macros to reduce +the code size. +*/ + +enum class IntrinsicElementalFunctions : int64_t { + ObjectType, + Kind, // if kind is reordered, update `extract_kind` in `asr_utils.h` + Rank, + Sin, + Cos, + Tan, + Asin, + Acos, + Atan, + Sinh, + Cosh, + Tanh, + Atan2, + Asinh, + Acosh, + Atanh, + Erf, + Erfc, + Gamma, + Log, + Log10, + LogGamma, + Trunc, + Fix, + Abs, + Aimag, + Exp, + Exp2, + Expm1, + FMA, + FlipSign, + Mod, + Trailz, + BesselJ0, + BesselJ1, + BesselY0, + Mvbits, + Shiftr, + Rshift, + Shiftl, + Dshiftl, + Ishft, + Bgt, + Blt, + Bge, + Ble, + Lgt, + Llt, + Lge, + Lle, + Exponent, + Fraction, + SetExponent, + Not, + Iand, + Ior, + Ieor, + Ibclr, + Ibset, + Btest, + Ibits, + Leadz, + ToLowerCase, + Digits, + Rrspacing, + Repeat, + StringContainsSet, + StringFindSet, + SubstrIndex, + Hypot, + SelectedIntKind, + SelectedRealKind, + SelectedCharKind, + Adjustl, + Adjustr, + Ichar, + Char, + MinExponent, + MaxExponent, + FloorDiv, + ListIndex, + Partition, + ListReverse, + ListPop, + ListReserve, + DictKeys, + DictValues, + SetAdd, + SetRemove, + Max, + Min, + Radix, + Scale, + Dprod, + Range, + Sign, + SignFromValue, + Nint, + Aint, + Anint, + Dim, + Sqrt, + Sngl, + Ifix, + Idint, + Floor, + Ceiling, + Ishftc, + Maskr, + Maskl, + Epsilon, + Precision, + Tiny, + Conjg, + Huge, + Popcnt, + Poppar, + SymbolicSymbol, + SymbolicAdd, + SymbolicSub, + SymbolicMul, + SymbolicDiv, + SymbolicPow, + SymbolicPi, + SymbolicE, + SymbolicInteger, + SymbolicDiff, + SymbolicExpand, + SymbolicSin, + SymbolicCos, + SymbolicLog, + SymbolicExp, + SymbolicAbs, + SymbolicHasSymbolQ, + SymbolicAddQ, + SymbolicMulQ, + SymbolicPowQ, + SymbolicLogQ, + SymbolicSinQ, + SymbolicGetArgument, + // ... +}; + +typedef ASR::expr_t* (*impl_function)( + Allocator&, const Location &, + SymbolTable*, Vec&, ASR::ttype_t *, + Vec&, int64_t); + +typedef ASR::expr_t* (*eval_intrinsic_function)( + Allocator&, const Location &, ASR::ttype_t *, + Vec&, diag::Diagnostics&); + +typedef ASR::asr_t* (*create_intrinsic_function)( + Allocator&, const Location&, + Vec&, + diag::Diagnostics&); + +typedef void (*verify_function)( + const ASR::IntrinsicElementalFunction_t&, + diag::Diagnostics&); + +typedef ASR::expr_t* (*get_initial_value_func)(Allocator&, ASR::ttype_t*); + +namespace UnaryIntrinsicFunction { + +static inline ASR::expr_t* instantiate_functions(Allocator &al, + const Location &loc, SymbolTable *scope, std::string new_name, + ASR::ttype_t *arg_type, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + switch (arg_type->type) { + case ASR::ttypeType::Complex : { + if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { + c_func_name = "_lfortran_c" + new_name; + } else { + c_func_name = "_lfortran_z" + new_name; + } + break; + } + default : { + if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { + c_func_name = "_lfortran_s" + new_name; + } else { + c_func_name = "_lfortran_d" + new_name; + } + } + } + new_name = "_lcompilers_" + new_name + "_" + type_to_str_python(arg_type); + + declare_basic_variables(new_name); + if (scope->get_symbol(new_name)) { + ASR::symbol_t *s = scope->get_symbol(new_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var)); + } + fill_func_arg("x", arg_type); + auto result = declare(new_name, ASRUtils::extract_type(return_type), ReturnVar); + + { + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; + { + args_1.reserve(al, 1); + ASR::expr_t *arg = b.Variable(fn_symtab_1, "x", arg_type, + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + } + + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + return_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); + + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + body.push_back(al, b.Assignment(result, b.Call(s, args, return_type))); + } + + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.Call(new_symbol, new_args, return_type); +} + +static inline ASR::asr_t* create_UnaryFunction(Allocator& al, const Location& loc, + Vec& args, eval_intrinsic_function eval_function, + int64_t intrinsic_id, int64_t overload_id, ASR::ttype_t* type, diag::Diagnostics& diag) { + ASR::expr_t *value = nullptr; + if (ASRUtils::all_args_evaluated(args)) { + Vec arg_values; arg_values.reserve(al, 1); + arg_values.push_back(al, ASRUtils::expr_value(args[0])); + value = eval_function(al, loc, type, arg_values, diag); + } + + return ASRUtils::make_IntrinsicElementalFunction_t_util(al, loc, intrinsic_id, + args.p, args.n, overload_id, type, value); +} + +static inline ASR::symbol_t *create_KMP_function(Allocator &al, + const Location &loc, SymbolTable *scope) +{ + /* + * Knuth-Morris-Pratt (KMP) string-matching + * This function takes two parameters: + * the sub-string or pattern string and the target string, + * then returns the position of the first occurrence of the + * string in the pattern. + */ + declare_basic_variables("KMP_string_matching"); + fill_func_arg("target_string", character(-2)); + fill_func_arg("pattern", character(-2)); + + auto result = declare("result", int32, ReturnVar); + auto pi_len = declare("pi_len", int32, Local); + auto i = declare("i", int32, Local); + auto j = declare("j", int32, Local); + auto s_len = declare("s_len", int32, Local); + auto pat_len = declare("pat_len", int32, Local); + auto flag = declare("flag", logical, Local); + auto lps = declare("lps", List(int32), Local); + + body.push_back(al, b.Assignment(s_len, b.StringLen(args[0]))); + body.push_back(al, b.Assignment(pat_len, b.StringLen(args[1]))); + body.push_back(al, b.Assignment(result, b.i32_n(-1))); + body.push_back(al, b.If(b.iEq(pat_len, b.i32(0)), { + b.Assignment(result, b.i32(0)), Return() + }, { + b.If(b.iEq(s_len, b.i32(0)), { Return() }, {}) + })); + body.push_back(al, b.Assignment(lps, + EXPR(ASR::make_ListConstant_t(al, loc, nullptr, 0, List(int32))))); + body.push_back(al, b.Assignment(i, b.i32(0))); + body.push_back(al, b.While(b.iLtE(i, b.iSub(pat_len, b.i32(1))), { + b.Assignment(i, b.iAdd(i, b.i32(1))), + b.ListAppend(lps, b.i32(0)) + })); + body.push_back(al, b.Assignment(flag, b.bool32(false))); + body.push_back(al, b.Assignment(i, b.i32(1))); + body.push_back(al, b.Assignment(pi_len, b.i32(0))); + body.push_back(al, b.While(b.iLt(i, pat_len), { + b.If(b.sEq(b.StringItem(args[1], b.iAdd(i, b.i32(1))), + b.StringItem(args[1], b.iAdd(pi_len, b.i32(1)))), { + b.Assignment(pi_len, b.iAdd(pi_len, b.i32(1))), + b.Assignment(b.ListItem(lps, i, int32), pi_len), + b.Assignment(i, b.iAdd(i, b.i32(1))) + }, { + b.If(b.iNotEq(pi_len, b.i32(0)), { + b.Assignment(pi_len, b.ListItem(lps, b.iSub(pi_len, b.i32(1)), int32)) + }, { + b.Assignment(i, b.iAdd(i, b.i32(1))) + }) + }) + })); + body.push_back(al, b.Assignment(j, b.i32(0))); + body.push_back(al, b.Assignment(i, b.i32(0))); + body.push_back(al, b.While(b.And(b.iGtE(b.iSub(s_len, i), + b.iSub(pat_len, j)), b.Not(flag)), { + b.If(b.sEq(b.StringItem(args[1], b.iAdd(j, b.i32(1))), + b.StringItem(args[0], b.iAdd(i, b.i32(1)))), { + b.Assignment(i, b.iAdd(i, b.i32(1))), + b.Assignment(j, b.iAdd(j, b.i32(1))) + }, {}), + b.If(b.iEq(j, pat_len), { + b.Assignment(result, b.iSub(i, j)), + b.Assignment(flag, b.bool32(true)), + b.Assignment(j, b.ListItem(lps, b.iSub(j, b.i32(1)), int32)) + }, { + b.If(b.And(b.iLt(i, s_len), b.sNotEq(b.StringItem(args[1], b.iAdd(j, b.i32(1))), + b.StringItem(args[0], b.iAdd(i, b.i32(1))))), { + b.If(b.iNotEq(j, b.i32(0)), { + b.Assignment(j, b.ListItem(lps, b.iSub(j, b.i32(1)), int32)) + }, { + b.Assignment(i, b.iAdd(i, b.i32(1))) + }) + }, {}) + }) + })); + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return fn_sym; +} + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, + diag::Diagnostics& diagnostics) { + const Location& loc = x.base.base.loc; + ASRUtils::require_impl(x.n_args == 1, + "Elemental intrinsics must have only 1 input argument", + loc, diagnostics); + + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); + ASR::ttype_t* output_type = x.m_type; + ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, output_type, true), + "The input and output type of elemental intrinsics must exactly match, input type: " + + ASRUtils::get_type_code(input_type) + " output type: " + ASRUtils::get_type_code(output_type), + loc, diagnostics); +} + +} // namespace UnaryIntrinsicFunction + +namespace BinaryIntrinsicFunction { + +static inline ASR::expr_t* instantiate_functions(Allocator &al, + const Location &loc, SymbolTable *scope, std::string new_name, + ASR::ttype_t *arg_type, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + switch (arg_type->type) { + case ASR::ttypeType::Complex : { + if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { + c_func_name = "_lfortran_c" + new_name; + } else { + c_func_name = "_lfortran_z" + new_name; + } + break; + } + default : { + if (ASRUtils::extract_kind_from_ttype_t(arg_type) == 4) { + c_func_name = "_lfortran_s" + new_name; + } else { + c_func_name = "_lfortran_d" + new_name; + } + } + } + new_name = "_lcompilers_" + new_name + "_" + type_to_str_python(arg_type); + + declare_basic_variables(new_name); + if (scope->get_symbol(new_name)) { + ASR::symbol_t *s = scope->get_symbol(new_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var)); + } + fill_func_arg("x", arg_type); + fill_func_arg("y", arg_type) + auto result = declare(new_name, return_type, ReturnVar); + + { + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; + { + args_1.reserve(al, 2); + ASR::expr_t *arg_1 = b.Variable(fn_symtab_1, "x", arg_type, + ASR::intentType::In, ASR::abiType::BindC, true); + ASR::expr_t *arg_2 = b.Variable(fn_symtab_1, "y", arg_type, + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg_1); + args_1.push_back(al, arg_2); + } + + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + arg_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); + + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + body.push_back(al, b.Assignment(result, b.Call(s, args, arg_type))); + } + + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.Call(new_symbol, new_args, return_type); +} + +static inline ASR::asr_t* create_BinaryFunction(Allocator& al, const Location& loc, + Vec& args, eval_intrinsic_function eval_function, + int64_t intrinsic_id, int64_t overload_id, ASR::ttype_t* type, diag::Diagnostics& diag) { + ASR::expr_t *value = nullptr; + ASR::expr_t *arg_value_1 = ASRUtils::expr_value(args[0]); + ASR::expr_t *arg_value_2 = ASRUtils::expr_value(args[1]); + if (arg_value_1 && arg_value_2) { + Vec arg_values; + arg_values.reserve(al, 2); + arg_values.push_back(al, arg_value_1); + arg_values.push_back(al, arg_value_2); + value = eval_function(al, loc, type, arg_values, diag); + } + + return ASRUtils::make_IntrinsicElementalFunction_t_util(al, loc, intrinsic_id, + args.p, args.n, overload_id, type, value); +} + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, + diag::Diagnostics& diagnostics) { + const Location& loc = x.base.base.loc; + ASRUtils::require_impl(x.n_args == 2, + "Binary intrinsics must have only 2 input arguments", + loc, diagnostics); + + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); + ASR::ttype_t* input_type_2 = ASRUtils::expr_type(x.m_args[1]); + ASR::ttype_t* output_type = x.m_type; + ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, input_type_2, true), + "The types of both the arguments of binary intrinsics must exactly match, argument 1 type: " + + ASRUtils::get_type_code(input_type) + " argument 2 type: " + ASRUtils::get_type_code(input_type_2), + loc, diagnostics); + ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, output_type, true), + "The input and output type of elemental intrinsics must exactly match, input type: " + + ASRUtils::get_type_code(input_type) + " output type: " + ASRUtils::get_type_code(output_type), + loc, diagnostics); +} + +} // namespace BinaryIntrinsicFunction + +// `X` is the name of the function in the IntrinsicElementalFunctions enum and +// we use the same name for `create_X` and other places +// `eval_X` is the name of the function in the `std` namespace for compile +// numerical time evaluation +// `lc_rt_name` is the name that we use in the C runtime library +#define create_unary_function(X, eval_X, lc_rt_name) \ +namespace X { \ + static inline ASR::expr_t *eval_##X(Allocator &al, const Location &loc, \ + ASR::ttype_t *t, Vec &args, \ + diag::Diagnostics& /*diag*/) { \ + double rv = ASR::down_cast(args[0])->m_r; \ + ASRUtils::ASRBuilder b(al, loc); \ + return b.f(std::eval_X(rv), t); \ + } \ + static inline ASR::asr_t* create_##X(Allocator &al, const Location &loc, \ + Vec &args, \ + diag::Diagnostics& diag) { \ + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); \ + if (args.n != 1) { \ + append_error(diag, "Intrinsic `"#X"` accepts exactly one argument", \ + loc); \ + return nullptr; \ + } else if (!ASRUtils::is_real(*type)) { \ + append_error(diag, "`x` argument of `"#X"` must be real", \ + args[0]->base.loc); \ + return nullptr; \ + } \ + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, \ + eval_##X, static_cast(IntrinsicElementalFunctions::X), \ + 0, type, diag); \ + } \ + static inline ASR::expr_t* instantiate_##X (Allocator &al, \ + const Location &loc, SymbolTable *scope, \ + Vec &arg_types, ASR::ttype_t *return_type, \ + Vec &new_args, int64_t overload_id) { \ + return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, \ + #lc_rt_name, arg_types[0], return_type, new_args, overload_id); \ + } \ +} // namespace X + +create_unary_function(Trunc, trunc, trunc) +create_unary_function(Gamma, tgamma, gamma) +create_unary_function(LogGamma, lgamma, log_gamma) +create_unary_function(Log10, log10, log10) +create_unary_function(Erf, erf, erf) +create_unary_function(Erfc, erfc, erfc) + +namespace ObjectType { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 1, + "ASR Verify: type() takes only 1 argument `object`", + x.base.base.loc, diagnostics); + } + + static ASR::expr_t *eval_ObjectType(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + ASRBuilder b(al, loc); + std::string object_type = "type) { + case ASR::ttypeType::Integer : { + object_type += "int"; break; + } case ASR::ttypeType::Real : { + object_type += "float"; break; + } case ASR::ttypeType::Character : { + object_type += "str"; break; + } case ASR::ttypeType::List : { + object_type += "list"; break; + } case ASR::ttypeType::Dict : { + object_type += "dict"; break; + } default: { + LCOMPILERS_ASSERT_MSG(false, "Unsupported type"); + break; + } + } + object_type += "'>"; + return b.StringConstant(object_type, character(object_type.length())); + } + + static inline ASR::asr_t* create_ObjectType(Allocator& al, const Location& loc, + Vec& args, diag::Diagnostics& diag) { + if (args.size() != 1) { + append_error(diag, "type() takes exactly 1 argument `object` for now", loc); + } + ASR::expr_t *m_value = nullptr; + Vec arg_values; + + + m_value = eval_ObjectType(al, loc, expr_type(args[0]), arg_values, diag); + + + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::ObjectType), + args.p, args.n, 0, ASRUtils::expr_type(m_value), m_value); + } + +} // namespace ObjectType + +namespace Fix { + static inline ASR::expr_t *eval_Fix(Allocator &al, const Location &loc, + ASR::ttype_t *t, Vec& args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(args.size() == 1); + double rv = ASR::down_cast(args[0])->m_r; + double val; + if (rv > 0.0) { + val = floor(rv); + } else { + val = ceil(rv); + } + return make_ConstantWithType(make_RealConstant_t, val, t, loc); + } + + static inline ASR::asr_t* create_Fix(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); + if (args.n != 1) { + append_error(diag, "Intrinsic `fix` accepts exactly one argument", loc); + return nullptr; + } else if (!ASRUtils::is_real(*type)) { + append_error(diag, "`fix` argument of `fix` must be real", + args[0]->base.loc); + return nullptr; + } + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, + eval_Fix, static_cast(IntrinsicElementalFunctions::Fix), + 0, type, diag); + } + + static inline ASR::expr_t* instantiate_Fix (Allocator &al, + const Location &loc, SymbolTable *scope, Vec& arg_types, + ASR::ttype_t *return_type, Vec& new_args, + int64_t overload_id) { + ASR::ttype_t* arg_type = arg_types[0]; + return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, + "fix", arg_type, return_type, new_args, overload_id); + } + +} // namespace Fix + +// `X` is the name of the function in the IntrinsicElementalFunctions enum and +// we use the same name for `create_X` and other places +// `stdeval` is the name of the function in the `std` namespace for compile +// numerical time evaluation +// `lcompilers_name` is the name that we use in the C runtime library +#define create_trig(X, stdeval, lcompilers_name) \ +namespace X { \ + static inline ASR::expr_t *eval_##X(Allocator &al, const Location &loc, \ + ASR::ttype_t *t, Vec& args, \ + diag::Diagnostics& /*diag*/) { \ + LCOMPILERS_ASSERT(args.size() == 1); \ + double rv = -1; \ + if( ASRUtils::extract_value(args[0], rv) ) { \ + double val = std::stdeval(rv); \ + return make_ConstantWithType(make_RealConstant_t, val, t, loc); \ + } else { \ + std::complex crv; \ + if( ASRUtils::extract_value(args[0], crv) ) { \ + std::complex val = std::stdeval(crv); \ + return ASRUtils::EXPR(ASR::make_ComplexConstant_t( \ + al, loc, val.real(), val.imag(), t)); \ + } \ + } \ + return nullptr; \ + } \ + static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ + Vec& args, \ + diag::Diagnostics& diag) \ + { \ + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); \ + if (args.n != 1) { \ + append_error(diag, "Intrinsic `"#X"` accepts exactly one argument", \ + loc); \ + return nullptr; \ + } else if (!ASRUtils::is_real(*type) && !ASRUtils::is_complex(*type)) { \ + append_error(diag, "`x` argument of `"#X"` must be real or complex",\ + args[0]->base.loc); \ + return nullptr; \ + } \ + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, \ + eval_##X, static_cast(IntrinsicElementalFunctions::X), \ + 0, type, diag); \ + } \ + static inline ASR::expr_t* instantiate_##X (Allocator &al, \ + const Location &loc, SymbolTable *scope, \ + Vec& arg_types, ASR::ttype_t *return_type, \ + Vec& new_args,int64_t overload_id) { \ + ASR::ttype_t* arg_type = arg_types[0]; \ + return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, \ + #lcompilers_name, arg_type, return_type, new_args, overload_id); \ + } \ +} // namespace X + +create_trig(Sin, sin, sin) +create_trig(Cos, cos, cos) +create_trig(Tan, tan, tan) +create_trig(Asin, asin, asin) +create_trig(Acos, acos, acos) +create_trig(Atan, atan, atan) +create_trig(Sinh, sinh, sinh) +create_trig(Cosh, cosh, cosh) +create_trig(Tanh, tanh, tanh) +create_trig(Asinh, asinh, asinh) +create_trig(Acosh, acosh, acosh) +create_trig(Atanh, atanh, atanh) +create_trig(Log, log, log) + +namespace Aimag { + + static inline ASR::expr_t *eval_Aimag(Allocator &al, const Location &loc, + ASR::ttype_t *t, Vec& args, diag::Diagnostics& /*diag*/) { + ASRUtils::ASRBuilder b(al, loc); + std::complex crv; + if( ASRUtils::extract_value(args[0], crv) ) { + return b.f(crv.imag(), t); + } else { + return nullptr; + } + } + + static inline ASR::expr_t* instantiate_Aimag (Allocator &al, + const Location &loc, SymbolTable* /*scope*/, + Vec& /*arg_types*/, ASR::ttype_t *return_type, + Vec &new_args,int64_t /*overload_id*/) { + return EXPR(ASR::make_ComplexIm_t(al, loc, new_args[0].m_value, + return_type, nullptr)); + } + +} // namespace Aimag + +namespace Atan2 { + static inline ASR::expr_t *eval_Atan2(Allocator &al, const Location &loc, + ASR::ttype_t *t, Vec& args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(args.size() == 2); + double rv = -1, rv2 = -1; + if( ASRUtils::extract_value(args[0], rv) && ASRUtils::extract_value(args[1], rv2) ) { + double val = std::atan2(rv,rv2); + return make_ConstantWithType(make_RealConstant_t, val, t, loc); + } + return nullptr; + } + static inline ASR::asr_t* create_Atan2(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) + { + ASR::ttype_t *type_1 = ASRUtils::expr_type(args[0]); + ASR::ttype_t *type_2 = ASRUtils::expr_type(args[1]); + if (!ASRUtils::is_real(*type_1)) { + append_error(diag, "`x` argument of \"atan2\" must be real",args[0]->base.loc); + return nullptr; + } else if (!ASRUtils::is_real(*type_2)) { + append_error(diag, "`y` argument of \"atan2\" must be real",args[1]->base.loc); + return nullptr; + } + return BinaryIntrinsicFunction::create_BinaryFunction(al, loc, args, + eval_Atan2, static_cast(IntrinsicElementalFunctions::Atan2), + 0, type_1, diag); + } + static inline ASR::expr_t* instantiate_Atan2 (Allocator &al, + const Location &loc, SymbolTable *scope, + Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args,int64_t overload_id) { + ASR::ttype_t* arg_type = arg_types[0]; + return BinaryIntrinsicFunction::instantiate_functions(al, loc, scope, + "atan2", arg_type, return_type, new_args, overload_id); + } +} + +namespace Abs { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + const Location& loc = x.base.base.loc; + ASRUtils::require_impl(x.n_args == 1, + "Elemental intrinsics must have only 1 input argument", + loc, diagnostics); + + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); + ASR::ttype_t* output_type = x.m_type; + std::string input_type_str = ASRUtils::get_type_code(input_type); + std::string output_type_str = ASRUtils::get_type_code(output_type); + if( ASR::is_a(*ASRUtils::type_get_past_pointer(ASRUtils::type_get_past_array(input_type))) ) { + ASRUtils::require_impl(ASR::is_a(*output_type), + "Abs intrinsic must return output of real for complex input, found: " + output_type_str, + loc, diagnostics); + int input_kind = ASRUtils::extract_kind_from_ttype_t(input_type); + int output_kind = ASRUtils::extract_kind_from_ttype_t(output_type); + ASRUtils::require_impl(input_kind == output_kind, + "The input and output type of Abs intrinsic must be of same kind, input kind: " + + std::to_string(input_kind) + " output kind: " + std::to_string(output_kind), + loc, diagnostics); + } else { + ASRUtils::require_impl(ASRUtils::check_equal_type(input_type, output_type, true), + "The input and output type of elemental intrinsics must exactly match, input type: " + + input_type_str + " output type: " + output_type_str, loc, diagnostics); + } + } + + static ASR::expr_t *eval_Abs(Allocator &al, const Location &loc, + ASR::ttype_t *t, Vec &args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); + ASR::expr_t* arg = args[0]; + if (ASRUtils::is_real(*expr_type(arg))) { + double rv = ASR::down_cast(arg)->m_r; + double val = std::abs(rv); + return make_ConstantWithType(make_RealConstant_t, val, t, loc); + } else if (ASRUtils::is_integer(*expr_type(arg))) { + int64_t rv = ASR::down_cast(arg)->m_n; + int64_t val = std::abs(rv); + return make_ConstantWithType(make_IntegerConstant_t, val, t, loc); + } else if (ASRUtils::is_complex(*expr_type(arg))) { + double re = ASR::down_cast(arg)->m_re; + double im = ASR::down_cast(arg)->m_im; + std::complex x(re, im); + double result = std::abs(x); + return make_ConstantWithType(make_RealConstant_t, result, t, loc); + } else { + return nullptr; + } + } + + static inline ASR::asr_t* create_Abs(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 1) { + append_error(diag, "Intrinsic abs function accepts exactly 1 argument", loc); + return nullptr; + } + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); + if (!ASRUtils::is_integer(*type) && !ASRUtils::is_real(*type) + && !ASRUtils::is_complex(*type)) { + append_error(diag, "Argument of the abs function must be Integer, Real or Complex", + args[0]->base.loc); + return nullptr; + } + if (is_complex(*type)) { + type = TYPE(ASR::make_Real_t(al, type->base.loc, + ASRUtils::extract_kind_from_ttype_t(type))); + } + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_Abs, + static_cast(IntrinsicElementalFunctions::Abs), 0, + ASRUtils::type_get_past_allocatable(type), diag); + } + + static inline ASR::expr_t* instantiate_Abs(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string func_name = "_lcompilers_abs_" + type_to_str_python(arg_types[0]); + declare_basic_variables(func_name); + if (scope->get_symbol(func_name)) { + ASR::symbol_t *s = scope->get_symbol(func_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); + } + fill_func_arg("x", arg_types[0]); + auto result = declare(func_name, return_type, ReturnVar); + /* + * if (x >= 0) then + * r = x + * else + * r = -x + * end if + */ + if (is_integer(*arg_types[0]) || is_real(*arg_types[0])) { + if (is_integer(*arg_types[0])) { + body.push_back(al, b.If(b.iGtE(args[0], b.i(0, arg_types[0])), { + b.Assignment(result, args[0]) + }, { + b.Assignment(result, b.i32_neg(args[0], arg_types[0])) + })); + } else { + body.push_back(al, b.If(b.fGtE(args[0], b.f(0, arg_types[0])), { + b.Assignment(result, args[0]) + }, { + b.Assignment(result, b.f32_neg(args[0], arg_types[0])) + })); + } + } else { + // * Complex type: `r = (real(x)**2 + aimag(x)**2)**0.5` + ASR::ttype_t *real_type = TYPE(ASR::make_Real_t(al, loc, + ASRUtils::extract_kind_from_ttype_t(arg_types[0]))); + ASR::down_cast(ASR::down_cast(result)->m_v)->m_type = return_type = real_type; + body.push_back(al, b.Assignment(result, + b.ElementalPow(b.ElementalAdd(b.ElementalPow(EXPR(ASR::make_ComplexRe_t(al, loc, + args[0], real_type, nullptr)), b.f(2.0, real_type), loc), b.ElementalPow(EXPR(ASR::make_ComplexIm_t(al, loc, + args[0], real_type, nullptr)), b.f(2.0, real_type), loc), loc), b.f(0.5, real_type), loc))); + } + ASR::symbol_t *f_sym = make_ASR_Function_t(func_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(func_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Abs + +namespace Radix { + + static ASR::expr_t *eval_Radix(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + ASRUtils::ASRBuilder b(al, loc); + return b.i32(2); + } + +} // namespace Radix + +namespace Scale { + static ASR::expr_t *eval_Scale(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + double value_X = ASR::down_cast(expr_value(args[0]))->m_r; + int64_t value_I = ASR::down_cast(expr_value(args[1]))->m_n; + double result = value_X * std::pow(2, value_I); + ASRUtils::ASRBuilder b(al, loc); + return b.f(result, arg_type); + } + + static inline ASR::expr_t* instantiate_Scale(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = scale(x, y) + * r = x * 2**y + */ + + //TODO: Radix for most of the device is 2, so we can use the b.i2r32(2) instead of args[1]. Fix (find a way to get the radix of the device and use it here) + body.push_back(al, b.Assignment(result, b.r_tMul(args[0], b.i2r32(b.iPow(b.i(2, arg_types[1]), args[1], arg_types[1])), arg_types[0]))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } +} // namespace Scale + +namespace Dprod { + static ASR::expr_t *eval_Dprod(Allocator &al, const Location &loc, + ASR::ttype_t* return_type, Vec &args, diag::Diagnostics& /*diag*/) { + double value_X = ASR::down_cast(expr_value(args[0]))->m_r; + double value_Y = ASR::down_cast(expr_value(args[1]))->m_r; + double result = value_X * value_Y; + ASRUtils::ASRBuilder b(al, loc); + return b.f(result, return_type); + } + + static inline ASR::expr_t* instantiate_Dprod(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = dprod(x, y) + * r = x * y + */ + body.push_back(al, b.Assignment(result, b.r2r64(b.r32Mul(args[0],args[1])))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Dprod + +namespace Range { + + static ASR::expr_t *eval_Range(Allocator &al, const Location &loc, + ASR::ttype_t */*return_type*/, Vec &args, diag::Diagnostics& /*diag*/) { + ASRUtils::ASRBuilder b(al, loc); + int64_t range_val = -1; + ASR::ttype_t *arg_type = expr_type(args[0]); + int32_t kind = extract_kind_from_ttype_t(arg_type); + if ( is_integer(*arg_type) ) { + switch ( kind ) { + case 1: { + range_val = 2; break; + } case 2: { + range_val = 4; break; + } case 4: { + range_val = 9; break; + } case 8: { + range_val = 18; break; + } default: { + break; + } + } + } else if ( is_real(*arg_type) || is_complex(*arg_type) ) { + switch ( kind ) { + case 4: { + range_val = 37; break; + } case 8: { + range_val = 307; break; + } default: { + break; + } + } + } + return b.i32(range_val); + } + +} // namespace Range + +namespace Sign { + + static ASR::expr_t *eval_Sign(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + if (ASRUtils::is_real(*t1)) { + double rv1 = std::abs(ASR::down_cast(args[0])->m_r); + double rv2 = ASR::down_cast(args[1])->m_r; + rv1 = copysign(rv1, rv2); + return make_ConstantWithType(make_RealConstant_t, rv1, t1, loc); + } else { + int64_t iv1 = std::abs(ASR::down_cast(args[0])->m_n); + int64_t iv2 = ASR::down_cast(args[1])->m_n; + if (iv2 < 0) iv1 = -iv1; + return make_ConstantWithType(make_IntegerConstant_t, iv1, t1, loc); + } + } + + static inline ASR::expr_t* instantiate_Sign(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_sign_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + if (is_real(*arg_types[0])) { + Vec args; args.reserve(al, 2); + visit_expr_list(al, new_args, args); + return ASRUtils::EXPR(ASR::make_RealCopySign_t(al, loc, args[0], args[1], arg_types[0], nullptr)); + } else { + /* + * r = abs(x) + * if (y < 0) then + * r = -r + * end if + */ + body.push_back(al, b.If(b.iGtE(args[0], b.i(0, arg_types[0])), { + b.Assignment(result, args[0]) + }, { + b.Assignment(result, b.i32_neg(args[0], arg_types[0])) + })); + body.push_back(al, b.If(b.iLt(args[1], b.i(0, arg_types[0])), { + b.Assignment(result, b.i32_neg(result, arg_types[0])) + }, {})); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + } + +} // namespace Sign + +namespace Shiftr { + + static ASR::expr_t *eval_Shiftr(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t val = val1 >> val2; + return make_ConstantWithType(make_IntegerConstant_t, val, t1, loc); + } + + static inline ASR::expr_t* instantiate_Shiftr(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = shiftr(x, y) + * r = x >> y + */ + body.push_back(al, b.Assignment(result, b.i_BitRshift(args[0], b.i2i(args[1], arg_types[0]), arg_types[0]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + + static inline ASR::expr_t* SHIFTR(ASRBuilder& b, ASR::expr_t* i, ASR::expr_t* shift, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(i), expr_type(shift)}, {i, shift}, expr_type(i), 0, Shiftr::instantiate_Shiftr); + } + +} // namespace Shiftr + +namespace Rshift { + + static ASR::expr_t *eval_Rshift(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t val = val1 >> val2; + return make_ConstantWithType(make_IntegerConstant_t, val, t1, loc); + } + + static inline ASR::expr_t* instantiate_Rshift(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = rshift(x, y) + * r = x >> y + */ + body.push_back(al, b.Assignment(result, b.i_BitRshift(args[0], args[1], arg_types[0]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + +} // namespace Rshift + +namespace Shiftl { + + static ASR::expr_t *eval_Shiftl(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t val = val1 << val2; + return make_ConstantWithType(make_IntegerConstant_t, val, t1, loc); + } + + static inline ASR::expr_t* instantiate_Shiftl(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_shiftl_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = shiftl(x, y) + * r = x << y + */ + body.push_back(al, b.Assignment(result, b.i_BitLshift(args[0], b.i2i(args[1], arg_types[0]), arg_types[0]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + + static inline ASR::expr_t* SHIFTL(ASRBuilder& b, ASR::expr_t* i, ASR::expr_t* shift, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(i), expr_type(shift)}, {i, shift}, expr_type(i), 0, Shiftl::instantiate_Shiftl); + } + +} // namespace Shiftl + +namespace Dshiftl { + + static ASR::expr_t *eval_Dshiftl(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& diag) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t shift = ASR::down_cast(args[2])->m_n; + int kind1 = ASRUtils::extract_kind_from_ttype_t(ASR::down_cast(args[0])->m_type); + int kind2 = ASRUtils::extract_kind_from_ttype_t(ASR::down_cast(args[1])->m_type); + if(kind1 != kind2) { + append_error(diag, "The kind of first argument of 'dshiftl' intrinsic must be the same as second arguement", loc); + return nullptr; + } + if(shift < 0){ + append_error(diag, "The shift argument of 'dshiftl' intrinsic must be non-negative integer", loc); + return nullptr; + } + int k_val = (kind1 == 8) ? 64: 32; + int64_t val = (val1 << shift) | (val2 >> (k_val - shift)); + return make_ConstantWithType(make_IntegerConstant_t, val, t1, loc); + } + + + static inline ASR::expr_t* instantiate_Dshiftl(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_dshiftl_" + type_to_str_python(arg_types[0])); + fill_func_arg("i", arg_types[0]); + fill_func_arg("j", arg_types[1]); + fill_func_arg("shift", arg_types[2]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = Dshiftl(x, y, shift) + * r = x << shift | y >> (32 - shift) ! kind = 4 + * r = x << shift | y >> (64 - shift) ! kind = 8 + */ + body.push_back(al, b.Assignment(result, b.i_BitLshift(args[0], b.i2i(args[2], return_type), return_type))); + body.push_back(al, b.If(b.iEq(b.i(extract_kind_from_ttype_t(arg_types[0]), int32), b.i(4, int32)), { + b.Assignment(result, b.i_BitOr(result, b.i_BitRshift(args[1], b.i_tSub(b.i(32, return_type), args[2], return_type), return_type), return_type)) + }, { + b.Assignment(result, b.i_BitOr(result, b.i_BitRshift(args[1], b.i_tSub(b.i(64, return_type), args[2], return_type), return_type), return_type)) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + +} // namespace Dshiftl + + +namespace Ishft { + + static ASR::expr_t *eval_Ishft(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t val; + if(val2<=0){ + val2 = val2 * -1; + val = val1 >> val2; + } else { + val = val1 << val2; + } + return make_ConstantWithType(make_IntegerConstant_t, val, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ishft(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ishft_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = ishft(x, y) + * if ( y <= 0) { + * r = x >> ( -1 * y) + * } else { + * r = x << y + * } + */ + body.push_back(al, b.If(b.iLtE(args[1], b.i(0, arg_types[0])), { + b.Assignment(result, b.i_BitRshift(args[0], b.iMul(b.i(-1, arg_types[0]), args[1]), arg_types[0])) + }, { + b.Assignment(result, b.i_BitLshift(args[0], args[1], arg_types[0])) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ishft + +namespace Bgt { + + static ASR::expr_t *eval_Bgt(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + bool result = false; + if (val1 * val2 > 0 || ((val1 * val2 == 0) && (val1 > 0 || val2 > 0))) { + if (val1 > val2) { + result = true; + } + } else { + if (val1 < val2) { + result = true; + } + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Bgt(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t */*return_type*/, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_bgt_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, logical, ReturnVar); + body.push_back(al, b.Assignment(result, b.bool32(0))); + body.push_back(al, b.If(b.Or(b.iGt(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.And(b.iEq(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.Or(b.iGt(args[0], b.i(0, arg_types[0])), b.iGt(args[1], b.i(0, arg_types[0]))))), { + b.If(b.iGt(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + }, { + b.If(b.iLt(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Bgt + +namespace Blt { + + static ASR::expr_t *eval_Blt(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + bool result = false; + if (val1 * val2 > 0 || ((val1 * val2 == 0) && (val1 > 0 || val2 > 0))) { + if (val1 < val2) { + result = true; + } + } else { + if (val1 > val2) { + result = true; + } + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Blt(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t */*return_type*/, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_blt_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, logical, ReturnVar); + body.push_back(al, b.Assignment(result, b.bool32(0))); + body.push_back(al, b.If(b.Or(b.iGt(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.And(b.iEq(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.Or(b.iGt(args[0], b.i(0, arg_types[0])), b.iGt(args[1], b.i(0, arg_types[0]))))), { + b.If(b.iLt(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + }, { + b.If(b.iGt(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Blt + +namespace Bge { + + static ASR::expr_t *eval_Bge(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + bool result = false; + if (val1 * val2 > 0 || ((val1 * val2 == 0) && (val1 > 0 || val2 > 0))) { + if (val1 >= val2) { + result = true; + } + } else { + if (val1 <= val2) { + result = true; + } + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Bge(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t */*return_type*/, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_bge_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, logical, ReturnVar); + body.push_back(al, b.Assignment(result, b.bool32(0))); + body.push_back(al, b.If(b.Or(b.iGt(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.And(b.iEq(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.Or(b.iGt(args[0], b.i(0, arg_types[0])), b.iGt(args[1], b.i(0, arg_types[0]))))), { + b.If(b.iGtE(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + }, { + b.If(b.iLtE(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Bge + +namespace Ble { + + static ASR::expr_t *eval_Ble(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + bool result = false; + if (val1 * val2 > 0 || ((val1 * val2 == 0) && (val1 > 0 || val2 > 0))) { + if (val1 <= val2) { + result = true; + } + } else { + if (val1 >= val2) { + result = true; + } + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ble(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t */*return_type*/, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ble_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, logical, ReturnVar); + body.push_back(al, b.Assignment(result, b.bool32(0))); + body.push_back(al, b.If(b.Or(b.iGt(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.And(b.iEq(b.iMul(args[0], args[1]), b.i(0, arg_types[0])), b.Or(b.iGt(args[0], b.i(0, arg_types[0])), b.iGt(args[1], b.i(0, arg_types[0]))))), { + b.If(b.iLtE(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + }, { + b.If(b.iGtE(args[0], args[1]), { + b.Assignment(result, b.bool32(1)) + }, {}) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Ble + +namespace Lgt { + + static ASR::expr_t *eval_Lgt(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* string_A = ASR::down_cast(args[0])->m_s; + char* string_B = ASR::down_cast(args[1])->m_s; + bool result = false; + if (strcmp(string_A, string_B) > 0) { + result = true; + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Lgt(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_lgt_" + type_to_str_python(type_get_past_allocatable(arg_types[0]))); + fill_func_arg("x", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("y", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.sGt(args[0], args[1]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Lgt + +namespace Llt { + + static ASR::expr_t *eval_Llt(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* string_A = ASR::down_cast(args[0])->m_s; + char* string_B = ASR::down_cast(args[1])->m_s; + bool result = false; + if (strcmp(string_A, string_B) < 0) { + result = true; + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Llt(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_llt_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("y", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.sLt(args[0], args[1]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Llt + +namespace Lge { + + static ASR::expr_t *eval_Lge(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* string_A = ASR::down_cast(args[0])->m_s; + char* string_B = ASR::down_cast(args[1])->m_s; + bool result = false; + if (strcmp(string_A, string_B) >= 0) { + result = true; + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Lge(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_lge_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("y", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.sGtE(args[0], args[1]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Lge + +namespace Lle { + + static ASR::expr_t *eval_Lle(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* string_A = ASR::down_cast(args[0])->m_s; + char* string_B = ASR::down_cast(args[1])->m_s; + bool result = false; + if (strcmp(string_A, string_B) <= 0) { + result = true; + } + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Lle(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_lle_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("y", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.sLtE(args[0], args[1]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, logical, nullptr); + } + +} // namespace Lle + +namespace Not { + + static ASR::expr_t *eval_Not(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val = ASR::down_cast(args[0])->m_n; + int64_t result = ~val; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Not(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_not_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = not(x) + * r = ~x + */ + body.push_back(al, b.Assignment(result, b.i_BitNot(args[0], return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + + static inline ASR::expr_t* NOT(ASRBuilder &b, ASR::expr_t* x, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(x)}, {x}, expr_type(x), 0, Not::instantiate_Not); + } + +} // namespace Not + +namespace Iand { + + static ASR::expr_t *eval_Iand(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t result; + result = val1 & val2; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Iand(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_iand_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = iand(x, y) + * r = x & y + */ + body.push_back(al, b.Assignment(result, b.i_BitAnd(args[0], args[1], return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + + static inline ASR::expr_t* IAND(ASRBuilder &b, ASR::expr_t* i, ASR::expr_t* j, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(i), expr_type(j)}, {i, j}, expr_type(i), 0, Iand::instantiate_Iand); + } + +} // namespace Iand + +namespace Ior { + + static ASR::expr_t *eval_Ior(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t result; + result = val1 | val2; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ior(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ior_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = ior(x, y) + * r = x | y + */ + body.push_back(al, b.Assignment(result, b.i_BitOr(args[0], args[1], return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + + static inline ASR::expr_t* IOR(ASRBuilder& b, ASR::expr_t* i, ASR::expr_t* j, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(i), expr_type(j)}, {i, j}, expr_type(i), 0, Ior::instantiate_Ior); + } + +} // namespace Ior + +namespace Ieor { + + static ASR::expr_t *eval_Ieor(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t result; + result = val1 ^ val2; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ieor(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ieor_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = ieor(x, y) + * r = x ^ y + */ + body.push_back(al, b.Assignment(result, b.i_BitXor(args[0], args[1], return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ieor + +namespace Ibclr { + + static ASR::expr_t *eval_Ibclr(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t result; + result = val1 & ~(1 << val2); + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ibclr(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ibclr_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = ibclr(x, y) + * r = x & ~( 1 << y ) + */ + body.push_back(al, b.Assignment(result, b.i_BitAnd(args[0], b.i_BitNot(b.i_BitLshift(b.i(1, arg_types[0]), args[1], return_type), return_type), return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ibclr + +namespace Ibset { + + static ASR::expr_t *eval_Ibset(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t result; + result = val1 | (1 << val2); + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ibset(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ibset_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = ibset(x, y) + * r = x | ( 1 << y ) + */ + body.push_back(al, b.Assignment(result, b.i_BitOr(args[0], b.i_BitLshift(b.i(1, arg_types[0]), args[1], return_type), return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ibset + +namespace Btest { + + static ASR::expr_t *eval_Btest(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + bool result; + if ((val1 & (1 << val2)) == 0) result = false; + else result = true; + return make_ConstantWithType(make_LogicalConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Btest(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_btest_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = btest(x, y) + * r = (( x & ( 1 << y )) == 0) ? .false. : .true. + */ + body.push_back(al, b.If(b.iEq(b.i_BitAnd(args[0], b.i_BitLshift(b.i(1, arg_types[0]), args[1], arg_types[0]), arg_types[0]), b.i(0, arg_types[0])), { + b.Assignment(result, b.bool32(0)) + }, { + b.Assignment(result, b.bool32(1)) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Btest + +namespace Ibits { + + static ASR::expr_t *eval_Ibits(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val1 = ASR::down_cast(args[0])->m_n; + int64_t val2 = ASR::down_cast(args[1])->m_n; + int64_t val3 = ASR::down_cast(args[2])->m_n; + int64_t result; + result = (val1 >> val2) & ((1 << val3) - 1); + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ibits(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ibits_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + fill_func_arg("z", arg_types[2]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = ibits(x, y, z) + * r = ( x >> y ) & ( ( 1 << z ) - 1 ) + */ + body.push_back(al, b.Assignment(result, b.i_BitAnd(b.i_BitRshift(args[0], b.i2i(args[1], arg_types[0]), return_type), b.iSub(b.i_BitLshift(b.i(1, arg_types[0]), b.i2i(args[2], arg_types[0]), return_type), b.i(1, arg_types[0])), return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ibits + +namespace Aint { + + static ASR::expr_t *eval_Aint(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + double rv = ASR::down_cast(expr_value(args[0]))->m_r; + ASRUtils::ASRBuilder b(al, loc); + return b.f(std::trunc(rv), arg_type); + } + + static inline ASR::expr_t* instantiate_Aint(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_aint_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + + // Cast: Real -> Integer -> Real + // TODO: this approach doesn't work for numbers > i64_max + body.push_back(al, b.Assignment(result, b.i2r(b.r2i64(args[0]), return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Aint + +namespace Anint { + + static ASR::expr_t *eval_Anint(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + double rv = ASR::down_cast(expr_value(args[0]))->m_r; + ASRUtils::ASRBuilder b(al, loc); + return b.f(std::round(rv), arg_type); + } + + static inline ASR::expr_t* instantiate_Anint(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_anint_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * if (x > 0) then + * r = aint(x+0.5) + * else + * r = aint(x-0.5) + * end if + */ + body.push_back(al, b.If(b.fGt(args[0], b.f(0, arg_types[0])), { + b.Assignment(result, b.CallIntrinsic(scope, {arg_types[0]}, {b.rAdd(args[0], b.f(0.5, arg_types[0]), arg_types[0])}, + return_type, 0, Aint::instantiate_Aint)) + }, { + b.Assignment(result, b.CallIntrinsic(scope, {arg_types[0]}, {b.rSub(args[0], b.f(0.5, arg_types[0]), arg_types[0])}, + return_type, 0, Aint::instantiate_Aint)) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Anint + +namespace Nint { + + static ASR::expr_t *eval_Nint(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + double rv = ASR::down_cast(expr_value(args[0]))->m_r; + double near_integer = std::round(rv); + int64_t result = int64_t(near_integer); + return make_ConstantWithType(make_IntegerConstant_t, result, arg_type, loc); + } + + static inline ASR::expr_t* instantiate_Nint(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_nint_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = nint(x) + * r = int(anint(x)) + */ + body.push_back(al,b.Assignment(result, b.r2i(b.CallIntrinsic(scope, {arg_types[0]}, {args[0]}, arg_types[0], 0, Anint::instantiate_Anint), return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } +} // namespace Nint + + +namespace Floor { + + static ASR::expr_t *eval_Floor(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + float val = ASR::down_cast(args[0])->m_r; + int64_t result = int64_t(val); + if(val<=0.0 && val!=result) { + result = result-1; + } + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Floor(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_floor_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = floor(x) + * r = int(x) + * if(x <= 0.00 && x != r){ + * r = int(x) - 1 + * } + */ + body.push_back(al, b.Assignment(result, b.r2i(args[0], return_type))); + body.push_back(al, b.If(b.And(b.fLtE(args[0], b.f(0, arg_types[0])), b.fNotEq(b.i2r(b.r2i(args[0], return_type), return_type), b.r2r(args[0], return_type))), + { + b.Assignment(result, b.i_tSub(b.r2i(args[0], return_type), b.i(1, return_type), return_type)) + }, {})); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + +} // namespace Floor + +namespace Ceiling { + + static ASR::expr_t *eval_Ceiling(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + double val = ASR::down_cast(args[0])->m_r; + double difference = val - double(int(val)); + int64_t result; + if (difference == 0.0) { + result = int(val); + } else if(val <= 0.0){ + result = int(val); + } else{ + result = int(val) + 1; + } + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ceiling(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ceiling_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = Ceiling(x) + * if(x >= 0.00){ + * if(x == int(x)){ + * r = int(x) + * } else { + * r = int(x) + 1 + * } + * } else { + * r = int(x) + * } + */ + body.push_back(al, b.If(b.fGtE(args[0], b.f(0, arg_types[0])), + { + b.If(b.fEq(b.r2r(args[0], return_type), + b.i2r(b.r2i(args[0], return_type), return_type) + ), + { + b.Assignment(result, b.r2i(args[0], return_type)) + }, { + b.Assignment(result, b.i_tAdd(b.r2i(args[0], return_type), b.i(1, return_type), return_type)) + }) + }, { + b.Assignment(result, b.r2i(args[0], return_type)) + })); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + +} // namespace Ceiling + +namespace Dim { + + static ASR::expr_t *eval_Dim(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + if (is_real(*t1)) { + double a = ASR::down_cast(args[0])->m_r; + double b = ASR::down_cast(args[1])->m_r; + double result; + double zero = 0.0; + if (a > b) { + result = a - b; + } else { + result = zero; + } + return make_ConstantWithType(make_RealConstant_t, result, t1, loc); + } + LCOMPILERS_ASSERT(is_integer(*t1)); + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t b = ASR::down_cast(args[1])->m_n; + int64_t result; + if (a > b) { + result = a - b; + } else { + result = 0; + } + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Dim(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_dim_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = Dim(x) + * if (x > y) { + * r = x - y + * } else { + * r = 0 + * } + */ + if (is_real(*arg_types[0])) { + body.push_back(al, b.If(b.fGt(args[0], args[1]), { + b.Assignment(result, b.r_tSub(args[0], args[1], arg_types[0])) + }, { + b.Assignment(result, b.f(0.0, arg_types[0])) + })); + } else { + body.push_back(al, b.If(b.iGt(args[0], args[1]), { + b.Assignment(result, b.i_tSub(args[0], args[1], arg_types[0])) + }, { + b.Assignment(result, b.i(0, arg_types[0])) + })); + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + +} // namespace Dim + +namespace Sqrt { + + static ASR::expr_t *eval_Sqrt(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + ASRUtils::ASRBuilder b(al, loc); + if (is_real(*arg_type)) { + double val = ASR::down_cast(expr_value(args[0]))->m_r; + return b.f(std::sqrt(val), arg_type); + } else { + std::complex crv; + if( ASRUtils::extract_value(args[0], crv) ) { + std::complex val = std::sqrt(crv); + return ASRUtils::EXPR(ASR::make_ComplexConstant_t( + al, loc, val.real(), val.imag(), arg_type)); + } else { + return nullptr; + } + } + } + + static inline ASR::expr_t* instantiate_Sqrt(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t overload_id) { + ASR::ttype_t* arg_type = arg_types[0]; + if (is_real(*arg_type)) { + return EXPR(ASR::make_RealSqrt_t(al, loc, + new_args[0].m_value, return_type, nullptr)); + } else { + return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, + "sqrt", arg_type, return_type, new_args, overload_id); + } + } + +} // namespace Sqrt + +namespace Exponent { + + static ASR::expr_t* eval_Exponent(Allocator& al, const Location& loc, + ASR::ttype_t* arg_type, Vec& args, diag::Diagnostics& /*diag*/) { + ASR::ttype_t* arguement_type = expr_type(args[0]); + int32_t kind = extract_kind_from_ttype_t(arguement_type); + + if (kind == 4) { + float x = ASR::down_cast(args[0])->m_r; + if (x == 0.0) { + return make_ConstantWithType(make_IntegerConstant_t, 0, arg_type, loc); + } + int32_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + int32_t exponent = ((ix >> 23) & 0xff) - 126; + return make_ConstantWithType(make_IntegerConstant_t, exponent, arg_type, loc); + } + else if (kind == 8) { + double x = ASR::down_cast(args[0])->m_r; + if (x == 0.0) { + return make_ConstantWithType(make_IntegerConstant_t, 0, arg_type, loc); + } + int64_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + int64_t exponent = ((ix >> 52) & 0x7ff) - 1022; + return make_ConstantWithType(make_IntegerConstant_t, exponent, arg_type, loc); + } + return nullptr; + } + + + static inline ASR::expr_t* instantiate_Exponent(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompiler_optimization_exponent_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + int32_t kind = extract_kind_from_ttype_t(arg_types[0]); + /* + if (x == 0.0) then + result = 0 + else + result = iand(shiftr(transfer(x, 0), 23), int(Z'0FF', kind=4)) - 126 ! for real kind = 4 + result = iand(shiftr(transfer(x, 0), 52), int(Z'7FF', kind=8)) - 1022 ! for real kind = 8 + end if + */ + if (kind == 8) { + body.push_back(al, b.If(b.fEq(args[0], b.f(0.0, arg_types[0])), { + b.Assignment(result, b.i32(0)) + }, { + b.Assignment(result, b.i2i32(b.i_tSub(b.i_tAnd(b.i_BitRshift(ASRUtils::EXPR(ASR::make_BitCast_t(al, loc, args[0], b.i64(0), nullptr, int64, nullptr)), + b.i64(52), int64), b.i64(0x7FF), int64), b.i64(1022), int64))) + })); + } else { + body.push_back(al, b.If(b.fEq(args[0], b.f(0.0, arg_types[0])), { + b.Assignment(result, b.i32(0)) + }, { + b.Assignment(result, b.i_tSub(b.i_tAnd(b.i_BitRshift(ASRUtils::EXPR(ASR::make_BitCast_t(al, loc, args[0], b.i32(0), nullptr, int32, nullptr)), + b.i32(23), int32), b.i32(0x0FF), int32), b.i32(126), int32)) + })); + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } +} // namespace Exponent + +namespace Fraction { + static ASR::expr_t *eval_Fraction(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + ASR::ttype_t* arguement_type = expr_type(args[0]); + int32_t kind = extract_kind_from_ttype_t(arguement_type); + if (kind == 4) { + float x = ASR::down_cast(args[0])->m_r; + int32_t exponent; + if (x == 0.0) { + exponent = 0; + float result = x * std::pow((2), (-1*(exponent))); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } + else{ + int32_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + exponent = ((ix >> 23) & 0xff) - 126; + float result = x * std::pow((2), (-1*(exponent))); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } + } + else if (kind == 8) { + double x = ASR::down_cast(args[0])->m_r; + int64_t exponent; + if (x == 0.0) { + exponent = 0; + double result = x * std::pow((2), (-1*(exponent))); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } + else{ + int64_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + exponent = ((ix >> 52) & 0x7ff) - 1022; + double result = x * std::pow((2), (-1*(exponent))); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } + } + return nullptr; + } + + static inline ASR::expr_t* instantiate_Fraction(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_fraction_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = fraction(x, y) + * r = x * radix(x)**(-exp(x)) + */ + ASR::expr_t* func_call_exponent = b.CallIntrinsic(scope, {arg_types[0]}, {args[0]}, int32, 0, Exponent::instantiate_Exponent); + body.push_back(al, b.Assignment(result, b.r_tMul(args[0], b.rPow(b.i2r(b.i(2, int32),return_type), b.r_tMul(b.i2r(b.i(-1,int32), return_type),b.i2r(func_call_exponent, return_type), return_type), return_type), return_type))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } +} // namespace Fraction + +namespace SetExponent { + static ASR::expr_t *eval_SetExponent(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + ASR::ttype_t* arguement_type = expr_type(args[0]); + int32_t kind = extract_kind_from_ttype_t(arguement_type); + if (kind == 4) { + float x = ASR::down_cast(args[0])->m_r; + int32_t I = ASR::down_cast(args[1])->m_n; + int32_t exponent; + if (x == 0.0) { + exponent = 0; + float result1 = x * std::pow((2), (-1*(exponent))); + float result = result1 * std::pow((2), I); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } else { + int32_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + exponent = ((ix >> 23) & 0xff) - 126; + float result1 = x * std::pow((2), (-1*(exponent))); + float result = result1 * std::pow((2), I); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } + } + else if (kind == 8) { + double x = ASR::down_cast(args[0])->m_r; + int64_t I = ASR::down_cast(args[1])->m_n; + int64_t exponent; + if (x == 0.0) { + exponent = 0; + double result1 = x * std::pow((2), (-1*(exponent))); + double result = result1 * std::pow((2), I); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } else { + int64_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + exponent = ((ix >> 52) & 0x7ff) - 1022; + double result1 = x * std::pow((2), (-1*(exponent))); + double result = result1 * std::pow((2), I); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + } + } + return nullptr; + } + + static inline ASR::expr_t* instantiate_SetExponent(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_setexponent_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("i", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + + /* + * r = setexponent(x, I) + * r = fraction(x) * radix(x)**(I) + */ + ASR::expr_t* func_call_fraction = b.CallIntrinsic(scope, {arg_types[0]}, {args[0]}, return_type, 0, Fraction::instantiate_Fraction); + body.push_back(al, b.Assignment(result, b.r_tMul(func_call_fraction, b.rPow(b.i2r(b.i32(2),return_type),b.i2r(args[1], return_type), return_type), return_type))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } +} // namespace SetExponent + +namespace Sngl { + + static ASR::expr_t *eval_Sngl(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + ASRUtils::ASRBuilder b(al, loc); + double val = ASR::down_cast(expr_value(args[0]))->m_r; + return b.f(val, arg_type); + } + + static inline ASR::expr_t* instantiate_Sngl(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_sngl_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.r2r32(args[0]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Sngl + +namespace Ifix { + + static ASR::expr_t *eval_Ifix(Allocator &al, const Location &loc, + ASR::ttype_t* /*arg_type*/, Vec &args, diag::Diagnostics& /*diag*/) { + int val = ASR::down_cast(expr_value(args[0]))->m_r; + return make_ConstantWithType(make_IntegerConstant_t, val, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), loc); + } + + static inline ASR::expr_t* instantiate_Ifix(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_ifix_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.r2i32(args[0]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ifix + +namespace Idint { + + static ASR::expr_t *eval_Idint(Allocator &al, const Location &loc, + ASR::ttype_t* /*arg_type*/, Vec &args, diag::Diagnostics& /*diag*/) { + int val = ASR::down_cast(expr_value(args[0]))->m_r; + return make_ConstantWithType(make_IntegerConstant_t, val, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), loc); + } + + static inline ASR::expr_t* instantiate_Idint(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_idint_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, b.r2i32(args[0]))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} + +namespace FMA { + + static ASR::expr_t *eval_FMA(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + double a = ASR::down_cast(args[0])->m_r; + double b = ASR::down_cast(args[1])->m_r; + double c = ASR::down_cast(args[2])->m_r; + return make_ConstantWithType(make_RealConstant_t, a + b*c, t1, loc); + } + + static inline ASR::expr_t* instantiate_FMA(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_fma_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + fill_func_arg("b", arg_types[0]); + fill_func_arg("c", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * result = a + b*c + */ + body.push_back(al, b.Assignment(result, + b.ElementalAdd(args[0], b.ElementalMul(args[1], args[2], loc), loc))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace FMA + + +namespace SignFromValue { + + static ASR::expr_t *eval_SignFromValue(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + if (is_real(*t1)) { + double a = ASR::down_cast(args[0])->m_r; + double b = ASR::down_cast(args[1])->m_r; + a = (b < 0 ? -a : a); + return make_ConstantWithType(make_RealConstant_t, a, t1, loc); + } + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t b = ASR::down_cast(args[1])->m_n; + a = (b < 0 ? -a : a); + return make_ConstantWithType(make_IntegerConstant_t, a, t1, loc); + + } + + static inline ASR::expr_t* instantiate_SignFromValue(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_signfromvalue_" + type_to_str_python(arg_types[0])); + fill_func_arg("a", arg_types[0]); + fill_func_arg("b", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + elemental real(real32) function signfromvaluer32r32(a, b) result(d) + real(real32), intent(in) :: a, b + d = a * asignr32(1.0_real32, b) + end function + */ + if (is_real(*arg_types[0])) { + body.push_back(al, b.If(b.fLt(args[1], b.f(0.0, arg_types[1])), { + b.Assignment(result, b.f32_neg(args[0], arg_types[0])) + }, { + b.Assignment(result, args[0]) + })); + } else { + body.push_back(al, b.If(b.iLt(args[1], b.i(0, arg_types[1])), { + b.Assignment(result, b.i32_neg(args[0], arg_types[0])) + }, { + b.Assignment(result, args[0]) + })); + } + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace SignFromValue + + +namespace FlipSign { + + static ASR::expr_t *eval_FlipSign(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int a = ASR::down_cast(args[0])->m_n; + double b = ASR::down_cast(args[1])->m_r; + if (a % 2 == 1) b = -b; + return make_ConstantWithType(make_RealConstant_t, b, t1, loc); + } + + static inline ASR::expr_t* instantiate_FlipSign(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_flipsign_" + type_to_str_python(arg_types[1])); + fill_func_arg("signal", arg_types[0]); + fill_func_arg("variable", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + real(real32) function flipsigni32r32(signal, variable) + integer(int32), intent(in) :: signal + real(real32), intent(out) :: variable + integer(int32) :: q + q = signal/2 + flipsigni32r32 = variable + if (signal - 2*q == 1 ) flipsigni32r32 = -variable + end subroutine + */ + + body.push_back(al, b.If(b.iEq(b.iSub(args[0], b.iMul(b.i(2, arg_types[0]), b.iDiv(args[0], b.i(2, arg_types[0])))), b.i(1, arg_types[0])), { + b.Assignment(result, b.f32_neg(args[1], arg_types[1])) + }, { + b.Assignment(result, args[1]) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace FlipSign + +namespace FloorDiv { + + static ASR::expr_t *eval_FloorDiv(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& diag) { + ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); + ASR::ttype_t *type2 = ASRUtils::expr_type(args[1]); + type1 = ASRUtils::type_get_past_const(type1); + type2 = ASRUtils::type_get_past_const(type2); + bool is_real1 = is_real(*type1); + bool is_real2 = is_real(*type2); + bool is_int1 = is_integer(*type1); + bool is_int2 = is_integer(*type2); + bool is_unsigned_int1 = is_unsigned_integer(*type1); + bool is_unsigned_int2 = is_unsigned_integer(*type2); + bool is_logical1 = is_logical(*type1); + bool is_logical2 = is_logical(*type2); + + + if (is_int1 && is_int2) { + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t b = ASR::down_cast(args[1])->m_n; + if (b == 0) { + append_error(diag, "Division by `0` is not allowed", loc); + return nullptr; + } + return make_ConstantWithType(make_IntegerConstant_t, a / b, t1, loc); + } else if (is_unsigned_int1 && is_unsigned_int2) { + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t b = ASR::down_cast(args[1])->m_n; + if (b == 0) { + append_error(diag, "Division by `0` is not allowed", loc); + return nullptr; + } + return make_ConstantWithType(make_UnsignedIntegerConstant_t, a / b, t1, loc); + } else if (is_logical1 && is_logical2) { + bool a = ASR::down_cast(args[0])->m_value; + bool b = ASR::down_cast(args[1])->m_value; + if (b == 0) { + append_error(diag, "Division by `0` is not allowed", loc); + return nullptr; + } + return make_ConstantWithType(make_LogicalConstant_t, a / b, t1, loc); + } else if (is_real1 && is_real2) { + double a = ASR::down_cast(args[0])->m_r; + double b = ASR::down_cast(args[1])->m_r; + if (b == 0.0) { + append_error(diag, "Division by `0` is not allowed", loc); + return nullptr; + } + double r = a / b; + int64_t result = (int64_t)r; + if ( r >= 0.0 || (double)result == r) { + return make_ConstantWithType(make_RealConstant_t, (double)result, t1, loc); + } + return make_ConstantWithType(make_RealConstant_t, (double)(result - 1), t1, loc); + } + return nullptr; + } + + static inline ASR::expr_t* instantiate_FloorDiv(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_floordiv_" + type_to_str_python(arg_types[1])); + fill_func_arg("a", arg_types[0]); + fill_func_arg("b", arg_types[1]); + auto r = declare("r", real64, Local); + auto tmp = declare("tmp", int64, Local); + auto result = declare("result", return_type, ReturnVar); + /* + @overload + def _lpython_floordiv(a: i32, b: i32) -> i32: + r: f64 # f32 rounds things up and gives incorrect tmps + tmp: i64 + result: i32 + r = float(a)/float(b) + tmp = i64(r) + if r < 0.0 and f64(tmp) != r: + tmp = tmp - 1 + result = i32(tmp) + return result + */ + body.push_back(al, b.Assignment(r, b.r64Div(CastingUtil::perform_casting(args[0], real64, al, loc), + CastingUtil::perform_casting(args[1], real64, al, loc)))); + body.push_back(al, b.Assignment(tmp, b.r2i64(r))); + body.push_back(al, b.If(b.And(b.fLt(r, b.f(0.0, real64)), b.fNotEq(b.i2r64(tmp), r)), { + b.Assignment(tmp, b.i64Sub(tmp, b.i(1, int64))) + }, {})); + body.push_back(al, b.Assignment(result, CastingUtil::perform_casting(tmp, return_type, al, loc))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace FloorDiv + +namespace Mod { + + static ASR::expr_t *eval_Mod(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + bool is_real1 = is_real(*ASRUtils::expr_type(args[0])); + bool is_real2 = is_real(*ASRUtils::expr_type(args[1])); + bool is_int1 = is_integer(*ASRUtils::expr_type(args[0])); + bool is_int2 = is_integer(*ASRUtils::expr_type(args[1])); + + if (is_int1 && is_int2) { + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t b = ASR::down_cast(args[1])->m_n; + return make_ConstantWithType(make_IntegerConstant_t, a % b, t1, loc); + } else if (is_real1 && is_real2) { + double a = ASR::down_cast(args[0])->m_r; + double b = ASR::down_cast(args[1])->m_r; + return make_ConstantWithType(make_RealConstant_t, std::fmod(a, b), t1, loc); + } + return nullptr; + } + + static inline ASR::expr_t* instantiate_Mod(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_mod_" + type_to_str_python(arg_types[1])); + fill_func_arg("a", arg_types[0]); + fill_func_arg("p", arg_types[1]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + function modi32i32(a, p) result(d) + integer(int32), intent(in) :: a, p + integer(int32) :: q + q = a/p + d = a - p*q + end function + */ + int kind = ASRUtils::extract_kind_from_ttype_t(arg_types[1]); + if (is_real(*arg_types[1])) { + if (kind == 4) { + body.push_back(al, b.Assignment(result, b.r32Sub(args[0], b.r32Mul(args[1], b.i2r32(b.r2i32(b.r32Div(args[0], args[1]))))))); + } else { + body.push_back(al, b.Assignment(result, b.r64Sub(args[0], b.r64Mul(args[1], b.i2r64(b.r2i64(b.r64Div(args[0], args[1]))))))); + } + } else { + if (kind == 1) { + body.push_back(al, b.Assignment(result, b.i8Sub(args[0], b.i8Mul(args[1], b.i8Div(args[0], args[1]))))); + } else if (kind == 2) { + body.push_back(al, b.Assignment(result, b.i16Sub(args[0], b.i16Mul(args[1], b.i16Div(args[0], args[1]))))); + } else if (kind == 4) { + body.push_back(al, b.Assignment(result, b.iSub(args[0], b.iMul(args[1], b.iDiv(args[0], args[1]))))); + } else if (kind == 8) { + body.push_back(al, b.Assignment(result, b.i64Sub(args[0], b.i64Mul(args[1], b.i64Div(args[0], args[1]))))); + } else { + LCOMPILERS_ASSERT(false); + } + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + static inline ASR::expr_t* MOD(ASRBuilder &b, ASR::expr_t* a, ASR::expr_t* p, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(a), expr_type(p)}, {a, p}, expr_type(a), 0, Mod::instantiate_Mod); + } + +} // namespace Mod + +namespace Popcnt { + + template + int compute_count(T mask, int64_t val) { + int count = 0; + while (mask != 0) { + if (val & mask) count++; + mask = mask << 1; + } + return count; + } + + static ASR::expr_t *eval_Popcnt(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int kind = ASRUtils::extract_kind_from_ttype_t(ASR::down_cast(args[0])->m_type); + int64_t val = static_cast(ASR::down_cast(args[0])->m_n); + int64_t mask1 = 1; + int32_t mask2 = 1; + int count = 0; + if (val < 0) { + count = kind == 4 ? compute_count(mask2, val) : compute_count(mask1, val); + } else { + while (val) { + count += val & 1; + val >>= 1; + } + } + return make_ConstantWithType(make_IntegerConstant_t, count, t1, loc); + } + + static inline ASR::expr_t* instantiate_Popcnt(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_popcnt_" + type_to_str_python(arg_types[0])); + fill_func_arg("i", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + auto count = declare("j", arg_types[0], Local); + auto val = declare("k", arg_types[0], Local); + auto mask = declare("l", arg_types[0], Local); + /* + function popcnt(i) result(r) + integer, intent(in) :: i + integer :: r, count, mask + count = 0 + mask = 1 + if (i >= 0) then + ! For positive numbers + do while (i /= 0) + count = count + mod(i, 2) + i = i / 2 + end do + else + ! For negative numbers + do while (mask /= 0) + if ((i .and. mask) /= 0) then + count = count + 1 + end if + mask = mask * 2 + end do + end if + r = count + end function popcnt + */ + body.push_back(al, b.Assignment(count, b.i(0,arg_types[0]))); + body.push_back(al, b.Assignment(val, args[0])); + body.push_back(al, b.Assignment(mask, b.i(1,arg_types[0]))); + body.push_back(al, b.If(b.iGtE(args[0], b.i(0,arg_types[0])), { + b.While(b.iNotEq(val, b.i(0, arg_types[0])), { + b.Assignment(count, b.i_tAdd(count, Mod::MOD(b, val, b.i(2, arg_types[0]), scope), arg_types[0])), + b.Assignment(val, b.i_tDiv(val, b.i(2, arg_types[0]), arg_types[0])) + }) + }, { + b.While(b.iNotEq(mask, b.i(0, arg_types[0])), { + b.If(b.iNotEq(b.i(0,arg_types[0]), (b.i_BitAnd(val,mask, arg_types[0]))), {b.Assignment(count, b.i_tAdd(count, b.i(1, arg_types[0]), arg_types[0]))}, + {}), + b.Assignment(mask, b.i_BitLshift(mask, b.i(1, arg_types[0]), arg_types[0])) + }) + })); + body.push_back(al, b.Assignment(result, b.i2i(count, return_type))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + static inline ASR::expr_t* POPCNT(ASRBuilder &b, ASR::expr_t* a, ASR::ttype_t *return_type, SymbolTable* scope) { + return b.CallIntrinsic(scope, {expr_type(a)}, {a}, return_type, 0, Popcnt::instantiate_Popcnt); + } +} // namespace Popcnt + +namespace Maskl { + static ASR::expr_t* eval_Maskl(Allocator& al, const Location& loc, + ASR::ttype_t* t1, Vec& args, diag::Diagnostics& /*diag*/) { + int32_t kind = ASRUtils::extract_kind_from_ttype_t(t1); + int64_t i = ASR::down_cast(args[0])->m_n; + if (((kind == 4) && i > 32) || (kind == 8 && i > 64) || i < 0) { + return nullptr; + } else { + int64_t one = 1; + int64_t minus_one = -1; + int64_t sixty_four = 64; + int64_t result = (i == 64) ? minus_one : ((one << i) - one) << (sixty_four - i); + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + } + + static inline ASR::expr_t* instantiate_Maskl(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = Maskl(x) + * r = (x == 64) ? -1 : ((1 << x) - 1) << (64 - x) + */ + body.push_back(al, b.If((b.iEq(b.i2i(args[0], return_type), b.i(64, return_type))), { + b.Assignment(result, b.i(-1, return_type)) + }, { + b.Assignment(result, b.i_BitLshift(b.i_tSub(b.i_BitLshift(b.i(1, return_type), b.i2i(args[0], return_type), return_type), b.i(1, return_type), return_type), + b.i_tSub(b.i(64, return_type), b.i2i(args[0], return_type), return_type), return_type)) + })); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Maskl + +namespace Maskr { + static ASR::expr_t* eval_Maskr(Allocator& al, const Location& loc, + ASR::ttype_t* t1, Vec& args, diag::Diagnostics& /*diag*/) { + int32_t kind = ASRUtils::extract_kind_from_ttype_t(t1); + int64_t i = ASR::down_cast(args[0])->m_n; + if (((kind == 4) && i > 32) || (kind == 8 && i > 64) || i < 0) { + return nullptr; + } + if(i == 64){ + return make_ConstantWithType(make_IntegerConstant_t, -1, t1, loc); + } + int64_t one = 1; + int64_t result = (one << i) - one; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Maskr(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = Maskr(x) + * r = (1 << x) - 1 + */ + body.push_back(al, b.If((b.iEq(b.i2i(args[0], return_type), b.i(64, return_type))), { + b.Assignment(result, b.i(-1, return_type)) + }, { + b.Assignment(result, b.i_tSub(b.i_BitLshift(b.i(1, return_type), b.i2i(args[0], return_type), return_type), b.i(1, return_type), return_type)) + })); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } +} // namespace Maskr + +namespace Trailz { + + static ASR::expr_t *eval_Trailz(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t kind = ASRUtils::extract_kind_from_ttype_t(t1); + int64_t trailing_zeros = ASRUtils::compute_trailing_zeros(a, kind); + return make_ConstantWithType(make_IntegerConstant_t, trailing_zeros, t1, loc); + } + + static inline ASR::expr_t* instantiate_Trailz(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_trailz_" + type_to_str_python(arg_types[0])); + fill_func_arg("n", arg_types[0]); + auto result = declare(fn_name, arg_types[0], ReturnVar); + // This is not the most efficient way to do this, but it works for now. + /* + function trailz(n) result(result) + integer :: n + integer :: result + integer :: k + k = kind(n) + result = 0 + if (n == 0) then + if (k == 4) then + result = 32 + else + result = 64 + end if + else + do while (mod(n,2) == 0) + n = n/2 + result = result + 1 + end do + end if + end function + */ + body.push_back(al, b.Assignment(result, b.i(0, arg_types[0]))); + body.push_back(al, b.If(b.iEq(args[0], b.i(0, arg_types[0])), { + b.Assignment(result, b.i(8*ASRUtils::extract_kind_from_ttype_t(arg_types[0]), arg_types[0])) + }, { + b.While(b.iEq(b.CallIntrinsic(scope, {arg_types[0], arg_types[0] + }, { + args[0], b.i(2, arg_types[0])}, return_type, 0, Mod::instantiate_Mod), b.i(0, arg_types[0])), + { + b.Assignment(args[0], b.i_tDiv(args[0], b.i(2, arg_types[0]), arg_types[0])), + b.Assignment(result, b.i_tAdd(result, b.i(1, arg_types[0]), arg_types[0])) + }) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Trailz + +namespace BesselJ0 { + + static ASR::expr_t *eval_BesselJ0(Allocator &/*al*/, const Location &/*loc*/, + ASR::ttype_t* /*t1*/, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + return nullptr; + } + + static inline ASR::expr_t* instantiate_BesselJ0(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + if (ASRUtils::extract_kind_from_ttype_t(arg_types[0]) == 4) { + c_func_name = "_lfortran_sbesselj0"; + } else { + c_func_name = "_lfortran_dbesselj0"; + } + std::string new_name = "_lcompilers_bessel_j0_"+ type_to_str_python(arg_types[0]); + + declare_basic_variables(new_name); + if (scope->get_symbol(new_name)) { + ASR::symbol_t *s = scope->get_symbol(new_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var)); + } + fill_func_arg("x", arg_types[0]); + auto result = declare(new_name, return_type, ReturnVar); + { + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; + { + args_1.reserve(al, 1); + ASR::expr_t *arg = b.Variable(fn_symtab_1, "x", arg_types[0], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + } + + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + return_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); + + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + body.push_back(al, b.Assignment(result, b.Call(s, args, return_type))); + } + + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.Call(new_symbol, new_args, return_type); + } + +} // namespace BesselJ0 + +namespace BesselJ1 { + + static ASR::expr_t *eval_BesselJ1(Allocator &/*al*/, const Location &/*loc*/, + ASR::ttype_t* /*t1*/, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + return nullptr; + } + + static inline ASR::expr_t* instantiate_BesselJ1(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + if (ASRUtils::extract_kind_from_ttype_t(arg_types[0]) == 4) { + c_func_name = "_lfortran_sbesselj1"; + } else { + c_func_name = "_lfortran_dbesselj1"; + } + std::string new_name = "_lcompilers_bessel_j1_"+ type_to_str_python(arg_types[0]); + + declare_basic_variables(new_name); + if (scope->get_symbol(new_name)) { + ASR::symbol_t *s = scope->get_symbol(new_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var)); + } + fill_func_arg("x", arg_types[0]); + auto result = declare(new_name, return_type, ReturnVar); + { + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; + { + args_1.reserve(al, 1); + ASR::expr_t *arg = b.Variable(fn_symtab_1, "x", arg_types[0], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + } + + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + return_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); + + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + body.push_back(al, b.Assignment(result, b.Call(s, args, return_type))); + } + + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.Call(new_symbol, new_args, return_type); + } + +} // namespace BesselJ1 + +namespace BesselY0 { + + static ASR::expr_t *eval_BesselY0(Allocator &/*al*/, const Location &/*loc*/, + ASR::ttype_t* /*t1*/, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + return nullptr; + } + + static inline ASR::expr_t* instantiate_BesselY0(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + if (ASRUtils::extract_kind_from_ttype_t(arg_types[0]) == 4) { + c_func_name = "_lfortran_sbessely0"; + } else { + c_func_name = "_lfortran_dbessely0"; + } + std::string new_name = "_lcompilers_bessel_y0_"+ type_to_str_python(arg_types[0]); + + declare_basic_variables(new_name); + if (scope->get_symbol(new_name)) { + ASR::symbol_t *s = scope->get_symbol(new_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var)); + } + fill_func_arg("x", arg_types[0]); + auto result = declare(new_name, return_type, ReturnVar); + { + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; + { + args_1.reserve(al, 1); + ASR::expr_t *arg = b.Variable(fn_symtab_1, "x", arg_types[0], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + } + + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + return_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); + + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + body.push_back(al, b.Assignment(result, b.Call(s, args, return_type))); + } + + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.Call(new_symbol, new_args, return_type); + } + +} // namespace BesselY0 + +namespace Poppar { + + static ASR::expr_t *eval_Poppar(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& diag) { + ASR::expr_t* count = Popcnt::eval_Popcnt(al, loc, t1, args, diag); + int result = ASR::down_cast(count)->m_n; + result = result % 2 == 0 ? 0 : 1; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Poppar(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_poppar_" + type_to_str_python(arg_types[0])); + fill_func_arg("i", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + function poppar(n) result(result) + integer, intent(in) :: n + integer :: result + integer :: count + count = popcnt(n) + result = mod(count, 2) + end function + */ + ASR::expr_t *func_call_poppar =Popcnt::POPCNT(b, args[0], return_type, scope); + body.push_back(al, b.Assignment(result, Mod::MOD(b, func_call_poppar, b.i(2, return_type), scope))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Poppar + +namespace Mvbits { + + static ASR::expr_t *eval_Mvbits(Allocator &/*al*/, const Location &/*loc*/, + ASR::ttype_t* /*t1*/, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + return nullptr; + } + + static inline ASR::expr_t* instantiate_Mvbits(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + if (ASRUtils::extract_kind_from_ttype_t(arg_types[0]) == 4) { + c_func_name = "_lfortran_mvbits32"; + } else { + c_func_name = "_lfortran_mvbits64"; + } + std::string new_name = "_lcompilers_mvbits_" + type_to_str_python(arg_types[0]); + declare_basic_variables(new_name); + fill_func_arg("from", arg_types[0]); + fill_func_arg("frompos", arg_types[1]); + fill_func_arg("len", arg_types[2]); + fill_func_arg("to", arg_types[3]); + fill_func_arg("topos", arg_types[4]); + auto result = declare(new_name, ASRUtils::extract_type(return_type), ReturnVar); + { + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; + { + args_1.reserve(al, 5); + ASR::expr_t *arg = b.Variable(fn_symtab_1, "from", arg_types[0], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + arg = b.Variable(fn_symtab_1, "frompos", arg_types[1], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + arg = b.Variable(fn_symtab_1, "len", arg_types[2], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + arg = b.Variable(fn_symtab_1, "to", arg_types[3], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + arg = b.Variable(fn_symtab_1, "topos", arg_types[4], + ASR::intentType::In, ASR::abiType::BindC, true); + args_1.push_back(al, arg); + } + + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + return_type, ASRUtils::intent_return_var, ASR::abiType::BindC, false); + + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + body.push_back(al, b.Assignment(result, b.Call(s, args, return_type))); + } + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + + static inline ASR::expr_t* MVBITS(ASRBuilder &b, ASR::expr_t* from, ASR::expr_t* frompos, + ASR::expr_t* len, ASR::expr_t* to, ASR::expr_t* topos, SymbolTable *scope) { + return b.CallIntrinsic( scope, {ASRUtils::expr_type(from), ASRUtils::expr_type(frompos), + ASRUtils::expr_type(len), ASRUtils::expr_type(to), ASRUtils::expr_type(topos)}, + {from, frompos, len, to, topos}, ASRUtils::expr_type(to), 0, Mvbits::instantiate_Mvbits); + } + +} // namespace Mvbits + +namespace Leadz { + + static ASR::expr_t *eval_Leadz(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t a = ASR::down_cast(args[0])->m_n; + int64_t kind = ASRUtils::extract_kind_from_ttype_t(t1); + int64_t leading_zeros = ASRUtils::compute_leading_zeros(a, kind); + return make_ConstantWithType(make_IntegerConstant_t, leading_zeros, t1, loc); + } + + static inline ASR::expr_t* instantiate_Leadz(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_leadz_" + type_to_str_python(arg_types[0])); + fill_func_arg("n", arg_types[0]); + auto result = declare(fn_name, arg_types[0], ReturnVar); + auto total_bits = declare("r", arg_types[0], Local); + auto number = declare("num", arg_types[0], Local); + /* + function leadz(n) result(result) + integer :: n, k, total_bits + integer :: result + k = kind(n) + total_bits = 32 + if (k == 8) total_bits = 64 + if (n<0) then + result = 0 + else + do while (total_bits > 0) + if (mod(n,2) == 0) then + result = result + 1 + else + result = 0 + end if + n = n/2 + total_bits = total_bits - 1 + end do + end if + end function + */ + body.push_back(al, b.Assignment(result, b.i(0, arg_types[0]))); + body.push_back(al, b.Assignment(number, args[0])); + body.push_back(al, b.Assignment(total_bits, b.i(8*ASRUtils::extract_kind_from_ttype_t(arg_types[0]), arg_types[0]))); + body.push_back(al, b.If(b.iLt(number, b.i(0, arg_types[0])), { + b.Assignment(result, b.i(0, arg_types[0])) + }, { + b.While(b.iGt(total_bits, b.i(0, arg_types[0])), { + b.If(b.iEq(b.CallIntrinsic(scope, {arg_types[0], arg_types[0]}, + {number, b.i(2, arg_types[0])}, return_type, 0, Mod::instantiate_Mod), b.i(0, arg_types[0])), { + b.Assignment(result, b.i_tAdd(result, b.i(1, arg_types[0]), arg_types[0])) + }, { + b.Assignment(result, b.i(0, arg_types[0])) + }), + b.Assignment(number, b.i_tDiv(number, b.i(2, arg_types[0]), arg_types[0])), + b.Assignment(total_bits, b.i_tSub(total_bits, b.i(1, arg_types[0]), arg_types[0])), + }), + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Leadz + +namespace Ishftc { + + static uint64_t cutoff_extra_bits(uint64_t num, uint32_t bits_size, uint32_t max_bits_size) { + if (bits_size == max_bits_size) { + return num; + } + return (num & ((1lu << bits_size) - 1lu)); + } + + static ASR::expr_t *eval_Ishftc(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& diag) { + uint64_t val = (uint64_t)ASR::down_cast(args[0])->m_n; + int64_t shift_signed = ASR::down_cast(args[1])->m_n; + int kind = ASRUtils::extract_kind_from_ttype_t(ASR::down_cast(args[0])->m_type); + bool negative_shift = (shift_signed < 0); + uint32_t shift = abs(shift_signed); + uint32_t bits_size = 8u * (uint32_t)kind; + uint32_t max_bits_size = 64; + if (bits_size < shift) { + append_error(diag, "The absolute value of SHIFT argument must be less than or equal to BIT_SIZE('I')", loc); + return nullptr; + } + val = cutoff_extra_bits(val, bits_size, max_bits_size); + uint64_t result; + if (negative_shift) { + result = (val >> shift) | cutoff_extra_bits(val << (bits_size - shift), bits_size, max_bits_size); + } else { + result = cutoff_extra_bits(val << shift, bits_size, max_bits_size) | ((val >> (bits_size - shift))); + } + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ishftc(Allocator & /*al*/, const Location & /*loc*/, + SymbolTable */*scope*/, Vec& /*arg_types*/, ASR::ttype_t */*return_type*/, + Vec& /*new_args*/, int64_t /*overload_id*/) { + // TO DO: Implement the runtime function for ISHFTC + throw LCompilersException("Runtime implementation for `ishftc` is not yet implemented."); + } + +} // namespace Ishftc + +namespace Hypot { + + static ASR::expr_t *eval_Hypot(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int kind = ASRUtils::extract_kind_from_ttype_t(t1); + if (kind == 4) { + float a = ASR::down_cast(args[0])->m_r; + float b = ASR::down_cast(args[1])->m_r; + return make_ConstantWithType(make_RealConstant_t, std::hypot(a, b), t1, loc); + } else { + double a = ASR::down_cast(args[0])->m_r; + double b = ASR::down_cast(args[1])->m_r; + return make_ConstantWithType(make_RealConstant_t, std::hypot(a, b), t1, loc); + } + } + + static inline ASR::expr_t* instantiate_Hypot(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_hypot_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, arg_types[0], ReturnVar); + /* + real function hypot_(x,y) result(hypot) + real :: x,y + hypot = sqrt(x*x + y*y) + end function + */ + body.push_back(al, b.Assignment(result, b.CallIntrinsic(scope, { + ASRUtils::expr_type(b.r_tAdd(b.r_tMul(args[0], args[0], arg_types[0]), b.r_tMul(args[1], args[1], arg_types[0]), arg_types[0])) + }, { + b.r_tAdd(b.r_tMul(args[0], args[0], arg_types[0]), b.r_tMul(args[1], args[1], arg_types[0]), arg_types[0]) + }, return_type, 0, Sqrt::instantiate_Sqrt))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Hypot + +namespace ToLowerCase { + + static ASR::expr_t *eval_ToLowerCase(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + + char* str = ASR::down_cast(args[0])->m_s; + std::transform(str, str + std::strlen(str), str, [](unsigned char c) { return std::tolower(c); }); + return make_ConstantWithType(make_StringConstant_t, str, t1, loc); + } + + static inline ASR::expr_t* instantiate_ToLowerCase(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("s", arg_types[0]); + ASR::ttype_t* char_type = ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, 0, nullptr)); + auto result = declare(fn_name, char_type, ReturnVar); + auto itr = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + + /* + function toLowerCase(str) result(result) + character(len=5) :: str + character(len=len(str)) :: result + integer :: i, ln + i = 1 + ln = len(str) + result = str + do while (i < ln) + if (result(i:i) >= 'A' .and. result(i:i) <= 'Z') then + result(i:i) = char(ichar(result(i:i)) + ichar('a') - ichar('A')) + end if + i = i + 1 + end do + print*, result + end function + */ + + body.push_back(al, b.Assignment(itr, b.i32(1))); + body.push_back(al, b.While(b.iLtE(itr, b.StringLen(args[0])), { + b.If(b.And(b.iGtE(ASRUtils::EXPR(ASR::make_Ichar_t(al, loc, ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, char_type, nullptr)), int32, nullptr)), b.Ichar("A", arg_types[0], int32)), + b.iLtE(ASRUtils::EXPR(ASR::make_Ichar_t(al, loc, ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, char_type, nullptr)), int32, nullptr)), b.Ichar("Z", arg_types[0], int32))), { + b.Assignment(result, b.StringConcat(result, ASRUtils::EXPR(ASR::make_StringChr_t(al, loc, + b.iSub(b.iAdd(ASRUtils::EXPR(ASR::make_Ichar_t(al, loc, ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, char_type, nullptr)), int32, nullptr)), b.Ichar("a", arg_types[0], int32)), + b.Ichar("A", arg_types[0], int32)), return_type, nullptr)), char_type)) + }, { + b.Assignment(result, b.StringConcat(result, ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, char_type, nullptr)), char_type)) + }), + b.Assignment(itr, b.i_tAdd(itr, b.i32(1), int32)), + })); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace ToLowerCase + +namespace SelectedIntKind { + + static ASR::expr_t *eval_SelectedIntKind(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t val = ASR::down_cast(args[0])->m_n; + ASRUtils::ASRBuilder b(al, loc); + int64_t result; + if (val <= 2) { + result = 1; + } else if (val <= 4) { + result = 2; + } else if (val <= 9) { + result = 4; + } else { + result = 8; + } + return b.i32(result); + } + + static inline ASR::expr_t* instantiate_SelectedIntKind(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, int32, ReturnVar); + auto number = declare("num", arg_types[0], Local); + body.push_back(al, b.Assignment(number, args[0])); + body.push_back(al, b.If(b.iLtE(number, b.i(2, arg_types[0])), { + b.Assignment(result, b.i(1, int32)) + }, { + b.If(b.iLtE(number, b.i(4, arg_types[0])), { + b.Assignment(result, b.i(2, int32)) + }, { + b.If(b.iLtE(number, b.i(9, arg_types[0])), { + b.Assignment(result, b.i(4, int32)) + }, { + b.Assignment(result, b.i(8, int32)) + }) + }) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace SelectedIntKind + +namespace SelectedRealKind { + + static inline ASR::expr_t *eval_SelectedRealKind(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t kind; + ASRUtils::ASRBuilder b(al, loc); + int64_t p = ASR::down_cast(args[0])->m_n; + int64_t r = ASR::down_cast(args[1])->m_n; + int64_t radix = ASR::down_cast(args[2])->m_n; + + if (p < 7 && r < 38 && radix == 2) { + kind = 4; + } else if (p < 16 && r < 308 && radix == 2) { + kind = 8; + } else if (radix != 2) { + kind = -5; + } else { + kind = -1; + } + return b.i32(kind); + } + + static inline ASR::expr_t* instantiate_SelectedRealKind(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("x", arg_types[0]); + fill_func_arg("y", arg_types[1]); + fill_func_arg("z", arg_types[2]); + auto result = declare(fn_name, int32, ReturnVar); + auto p = declare("p", arg_types[0], Local); + auto r = declare("r", arg_types[1], Local); + auto radix = declare("radix", arg_types[2], Local); + + body.push_back(al, b.Assignment(p, args[0])); + body.push_back(al, b.Assignment(r, args[1])); + body.push_back(al, b.Assignment(radix, args[2])); + body.push_back(al, b.If(b.And(b.And(b.iLt(p, b.i(7, arg_types[0])), b.iLt(r, b.i(38, arg_types[1]))), b.iEq(radix, b.i(2, arg_types[2]))), { + b.Assignment(result, b.i(4, int32)) + }, { + b.If( b.And(b.And(b.iLt(p, b.i(15, arg_types[0])), b.iLt(r, b.i(308, arg_types[1]))), b.iEq(radix, b.i(2, arg_types[2]))), { + b.Assignment(result, b.i(8, int32)) + }, { + b.If(b.iNotEq(radix, b.i(2, arg_types[2])), { + b.Assignment(result, b.i(-5, int32)) + }, { + b.Assignment(result, b.i(-1, int32)) + }) + }) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace SelectedRealKind + +namespace SelectedCharKind { + + static inline ASR::expr_t *eval_SelectedCharKind(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t kind; + ASRUtils::ASRBuilder b(al, loc); + char* name = ASR::down_cast(args[0])->m_s; + std::string lowercase_name = to_lower(name); + if (lowercase_name == "ascii" || lowercase_name == "default") { + kind = 1; + } else if (lowercase_name == "iso_10646") { + kind = 4; + } else { + kind = -1; + } + return b.i32(kind); + } + + static inline ASR::expr_t* instantiate_SelectedCharKind(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_selected_char_kind_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + + ASR::expr_t* func_call_lowercase = b.CallIntrinsic(scope, {arg_types[0]}, + {args[0]}, arg_types[0], 0, ToLowerCase::instantiate_ToLowerCase); + body.push_back(al, b.If(b.Or(b.sEq(func_call_lowercase, b.StringConstant("ascii", arg_types[0])), + b.sEq(func_call_lowercase, b.StringConstant("default", arg_types[0]))), { + b.Assignment(result, b.i(1, return_type)) + }, { + b.If(b.sEq(func_call_lowercase, b.StringConstant("iso_10646", arg_types[0])), { + b.Assignment(result, b.i(4, return_type)) + }, { + b.Assignment(result, b.i(-1, return_type)) + }) + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace SelectedCharKind + +namespace Kind { + + static ASR::expr_t *eval_Kind(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + int result = ASRUtils::extract_kind_from_ttype_t(ASRUtils::expr_type(args[0])); + return make_ConstantWithType(make_IntegerConstant_t, result, int32, loc); + } + + static inline ASR::expr_t* instantiate_Kind(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_kind_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, int32, ReturnVar); + body.push_back(al, b.Assignment(result, b.i32(ASRUtils::extract_kind_from_ttype_t(arg_types[0])))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Kind + +namespace Rank { + + static ASR::expr_t *eval_Rank(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + ASRUtils::ASRBuilder b(al, loc); + return b.i32(extract_n_dims_from_ttype(expr_type(args[0]))); + } + +} // namespace Rank + +namespace Adjustl { + + static ASR::expr_t *eval_Adjustl(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* str = ASR::down_cast(args[0])->m_s; + size_t len = std::strlen(str); + size_t first_non_space = 0; + while (first_non_space < len && std::isspace(str[first_non_space])) { + first_non_space++; + } + std::string res(len, ' '); + char* result = s2c(al, res); + std::strncpy(result, str + first_non_space, len - first_non_space); + return make_ConstantWithType(make_StringConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Adjustl(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_adjustl_" + type_to_str_python(arg_types[0])); + fill_func_arg("str", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, args[0], int32, nullptr)))); + auto result = declare("result", return_type, ReturnVar); + auto itr = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto tmp = declare("tmp", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + + /* + function adjustl_(s) result(r) + character(len=*), intent(in) :: s + character(len=len(s)) :: r + integer :: i, tmp + i = 1 + do while (i <= len(s)) + if (isspace(s(i:i))) then + i = i + 1 + else + exit + end if + end do + if i <= len(s) then + tmp = len(s) - i + 1 + r(1:tmp) = s(i:len(s)) + end if + end function + */ + + body.push_back(al, b.Assignment(itr, b.i32(1))); + body.push_back(al, b.While(b.iLtE(itr, b.StringLen(args[0])), { + b.If(b.iEq(ASRUtils::EXPR(ASR::make_Ichar_t(al, loc, + ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, + ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr)), nullptr)), int32, nullptr)), + b.Ichar(" ", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, 1, nullptr)), int32)), { + b.Assignment(itr, b.i_tAdd(itr, b.i32(1), int32)) + }, { + b.Exit(nullptr) + }), + })); + + body.push_back(al, b.If(b.iLtE(itr, b.StringLen(args[0])), { + b.Assignment(tmp, b.iAdd(b.iSub(b.StringLen(args[0]), itr), b.i32(1))), + b.Assignment(b.StringSection(result, b.i32(0), tmp), b.StringSection(args[0], b.i_tSub(itr, b.i32(1), int32), b.StringLen(args[0]))) + }, {})); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, new_args[0].m_value, int32, nullptr)))); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace AdjustL + +namespace Adjustr { + + static ASR::expr_t *eval_Adjustr(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* str = ASR::down_cast(args[0])->m_s; + size_t len = std::strlen(str); + int last_non_space = len - 1; + while (last_non_space >= 0 && std::isspace(str[last_non_space])) { + last_non_space--; + } + std::string res(len, ' '); + char* result = s2c(al, res); + if (last_non_space != -1) { + int tmp = len - 1 - last_non_space; + for (int i = 0; i <= last_non_space; i++) { + result[i + tmp] = str[i]; + } + } + return make_ConstantWithType(make_StringConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Adjustr(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_adjustr_" + type_to_str_python(arg_types[0])); + fill_func_arg("str", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, args[0], int32, nullptr)))); + auto result = declare("result", return_type, ReturnVar); + auto itr = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto tmp = declare("tmp", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + + /* + function adjustr_(s) result(r) + character(len=*), intent(in) :: s + character(len=len(s)) :: r + integer :: i, tmp + i = len(s) + do while (i >= 1) + if isspace(s(i:i)) then + i = i - 1 + else + exit + end if + end do + if i /= 0 then + tmp = len(s) - i + 1 + r(tmp:len(s)) = s(1:i) + end if + end function + */ + + body.push_back(al, b.Assignment(itr, b.StringLen(args[0]))); + body.push_back(al, b.While(b.iGtE(itr, b.i32(1)), { + b.If(b.iEq(ASRUtils::EXPR(ASR::make_Ichar_t(al, loc, + ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, + ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr)), nullptr)), int32, nullptr)), + b.Ichar(" ", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, 1, nullptr)), int32)), { + b.Assignment(itr, b.i_tSub(itr, b.i32(1), int32)) + }, { + b.Exit(nullptr) + }), + })); + + body.push_back(al, b.If(b.iNotEq(itr, b.i32(0)), { + b.Assignment(tmp, b.iAdd(b.iSub(b.StringLen(args[0]), itr), b.i32(1))), + b.Assignment(b.StringSection(result, b.iSub(tmp, b.i32(1)), b.StringLen(args[0])), + b.StringSection(args[0], b.i32(0), itr)) + }, {})); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, new_args[0].m_value, int32, nullptr)))); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Adjustr + + +namespace Ichar { + + static ASR::expr_t *eval_Ichar(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* str = ASR::down_cast(args[0])->m_s; + char first_char = str[0]; + int result = (int)first_char; + return make_ConstantWithType(make_IntegerConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Ichar(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_ichar_" + type_to_str_python(arg_types[0])); + fill_func_arg("str", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + auto result = declare("result", return_type, ReturnVar); + auto itr = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + body.push_back(al, b.Assignment(itr, b.i32(1))); + body.push_back(al, b.Assignment(result, b.i2i( + ASRUtils::EXPR(ASR::make_Ichar_t(al, loc, ASRUtils::EXPR(ASR::make_StringItem_t(al, loc, args[0], itr, + ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr)), nullptr)), int32, nullptr)), + return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Ichar + +namespace Char { + + static ASR::expr_t *eval_Char(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + int64_t i = ASR::down_cast(args[0])->m_n; + char str = i; + std::string svalue; + svalue += str; + Str s; + s.from_str_view(svalue); + char *result = s.c_str(al); + return make_ConstantWithType(make_StringConstant_t, result, t1, loc); + } + + static inline ASR::expr_t* instantiate_Char(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables(""); + fill_func_arg("i", arg_types[0]); + auto result = declare("result", return_type, ReturnVar); + + body.push_back(al, b.Assignment(result, ASRUtils::EXPR(ASR::make_StringChr_t(al, loc, b.i2i(args[0], int32), return_type, nullptr)))); + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Char + +namespace Digits { + + static ASR::expr_t *eval_Digits(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& diag) { + ASR::ttype_t *type1 = ASRUtils::expr_type(args[0]); + int kind = ASRUtils::extract_kind_from_ttype_t(ASRUtils::expr_type(args[0])); + if (is_integer(*type1)) { + if (kind == 4) { + return make_ConstantWithType(make_IntegerConstant_t, 31, int32, loc); + } else if (kind == 8) { + return make_ConstantWithType(make_IntegerConstant_t, 63, int32, loc); + } else { + append_error(diag, "Kind "+ std::to_string(kind) + " not supported for type Integer", loc); + } + } else if (is_real(*type1)) { + if (kind == 4) { + return make_ConstantWithType(make_IntegerConstant_t, 24, int32, loc); + } else if (kind == 8) { + return make_ConstantWithType(make_IntegerConstant_t, 53, int32, loc); + } else { + append_error(diag, "Kind "+ std::to_string(kind) + " not supported for type Real", loc); + } + } else { + append_error(diag, "Argument to `digits` intrinsic must be real or integer", loc); + } + return nullptr; + } + + static inline ASR::expr_t* instantiate_Digits(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_digits_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, int32, ReturnVar); + int kind = ASRUtils::extract_kind_from_ttype_t(arg_types[0]); + if (is_integer(*arg_types[0])) { + if (kind == 4) { + body.push_back(al, b.Assignment(result, b.i32(31))); + } else if (kind == 8) { + body.push_back(al, b.Assignment(result, b.i32(63))); + } + } else if (is_real(*arg_types[0])) { + if (kind == 4) { + body.push_back(al, b.Assignment(result, b.i32(24))); + } else if (kind == 8) { + body.push_back(al, b.Assignment(result, b.i32(53))); + } + } + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Digits + +namespace Rrspacing { + + static ASR::expr_t *eval_Rrspacing(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + int kind = ASRUtils::extract_kind_from_ttype_t(ASRUtils::expr_type(args[0])); + double digits = 0.0; + double fraction = 0.0; + digits = (kind == 4) ? 24.00 : 53.00; + if (kind == 4) { + float x = ASR::down_cast(args[0])->m_r; + int32_t exponent; + if (x == 0.0) { + exponent = 0; + fraction = x * std::pow((2), (-1*(exponent))); + } + else{ + int32_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + exponent = ((ix >> 23) & 0xff) - 126; + fraction = x * std::pow((2), (-1*(exponent))); + } + } + else if (kind == 8) { + double x = ASR::down_cast(args[0])->m_r; + int64_t exponent; + if (x == 0.0) { + exponent = 0; + fraction = x * std::pow((2), (-1*(exponent))); + } + else{ + int64_t ix; + std::memcpy(&ix, &x, sizeof(ix)); + exponent = ((ix >> 52) & 0x7ff) - 1022; + fraction = x * std::pow((2), (-1*(exponent))); + } + } + fraction = std::abs(fraction); + double radix = 2.00; + double result = fraction * std::pow(radix, digits); + return make_ConstantWithType(make_RealConstant_t, result, arg_type, loc); + + } + + static inline ASR::expr_t* instantiate_Rrspacing(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_rrspacing_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, return_type, ReturnVar); + /* + * r = rrspacing(X) + * r = abs(fraction(X)) * (radix(X)**digits(X)) + */ + body.push_back(al, b.Assignment(result, b.r_tMul(b.CallIntrinsic(scope, {arg_types[0]}, { + b.CallIntrinsic(scope, {arg_types[0]}, {args[0]}, return_type, 0, Fraction::instantiate_Fraction)}, + return_type, 0, Abs::instantiate_Abs), b.rPow(b.i2r(b.i32(2),return_type), + b.i2r(b.CallIntrinsic(scope, {arg_types[0]}, {args[0]}, int32, 0, Digits::instantiate_Digits), + return_type), return_type), return_type))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + + } + +} // namespace Rrspacing + +namespace Repeat { + + static ASR::expr_t *eval_Repeat(Allocator &al, const Location &loc, + ASR::ttype_t* t1, Vec &args, diag::Diagnostics& /*diag*/) { + char* str = ASR::down_cast(args[0])->m_s; + int64_t n = ASR::down_cast(args[1])->m_n; + size_t len = std::strlen(str); + size_t new_len = len*n; + char* result = new char[new_len+1]; + for (size_t i=0; i& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + auto func_name = "_lcompilers_optimization_repeat_" + type_to_str_python(arg_types[0]) + + type_to_str_python(arg_types[1]); + declare_basic_variables(func_name); + if (scope->get_symbol(func_name)) { + ASR::symbol_t *s = scope->get_symbol(func_name); + return b.Call(s, new_args, return_type, nullptr); + } + fill_func_arg("x", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -10, nullptr))); + fill_func_arg("y", arg_types[1]); + auto result = declare(fn_name, ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -3, + ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, loc, + ASRUtils::EXPR(ASR::make_StringLen_t(al, loc, args[0], ASRUtils::expr_type(args[1]), nullptr)), + ASR::binopType::Mul, args[1], ASRUtils::expr_type(args[1]), nullptr)))), ReturnVar); + auto i = declare("i", int32, Local); + auto j = declare("j", int32, Local); + auto m = declare("m", int32, Local); + auto cnt = declare("cnt", int32, Local); + /* + function repeat_(s, n) result(r) + character(len=*), intent(in) :: s + integer, intent(in) :: n + character(len=n*len(s)) :: r + integer :: i, j, m, cnt + m = len(s) + i = 1 + j = m + cnt = 0 + do while (cnt < n) + r(i:j) = s(1:len(s)) + i = j + 1 + j = i + m - 1 + cnt = cnt + 1 + end do + end function + */ + + body.push_back(al, b.Assignment(m, b.StringLen(args[0]))); + body.push_back(al, b.Assignment(i, b.i32(1))); + body.push_back(al, b.Assignment(j, m)); + body.push_back(al, b.Assignment(cnt, b.i32(0))); + body.push_back(al, b.While(b.iLt(cnt, CastingUtil::perform_casting(args[1], int32, al, loc)), { + b.Assignment(b.StringSection(result, b.iSub(i, b.i32(1)), j), + b.StringSection(args[0], b.i32(0), b.StringLen(args[0]))), + b.Assignment(i, b.iAdd(j, b.i32(1))), + b.Assignment(j, b.iSub(b.iAdd(i, m), b.i32(1))), + b.Assignment(cnt, b.iAdd(cnt, b.i32(1))), + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Repeat + +namespace StringContainsSet { + + static ASR::expr_t *eval_StringContainsSet(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + char* string = ASR::down_cast(args[0])->m_s; + char* set = ASR::down_cast(args[1])->m_s; + bool back = ASR::down_cast(args[2])->m_value; + int64_t kind = ASR::down_cast(args[3])->m_n; + size_t len = std::strlen(string); + int64_t result = 0; + if (back) { + for (size_t i=0; i& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_verify_" + type_to_str_python(arg_types[0])); + fill_func_arg("str", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("set", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("back", ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + fill_func_arg("kind", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + auto result = declare(fn_name, return_type, ReturnVar); + auto matched = declare("matched", arg_types[2], Local); + auto i = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto j = declare("j", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + /* + function StringContainsSet_(string, set, back, kind) result(result) + character(len=*) :: string + character(len=*) :: set + logical, optional :: back + integer(kind) :: result = 0 + integer :: i, j + logical :: matched + if (back) then + i = len(string) + do while (i >= 1) + matched = .false. + j = 1 + do while (j <= len(set)) + if (string(i:i) == set(j:j)) then + matched = .true. + end if + j = j + 1 + end do + if (.not. matched) then + result = i + exit + end if + i = i - 1 + end do + else + i = 1 + do while (i <= len(string)) + matched = .false. + j = 1 + do while (j <= len(set)) + if (string(i:i) == set(j:j)) then + matched = .true. + end if + j = j + 1 + end do + if (.not. matched) then + result = i + exit + end if + i = i + 1 + end do + end if + end function + */ + body.push_back(al, b.Assignment(result, b.i(0, return_type))); + body.push_back(al, b.If(b.boolEq(args[2], b.bool32(1)), { + b.Assignment(i, b.StringLen(args[0])), + b.While(b.iGtE(i, b.i(1, return_type)), { + b.Assignment(matched, b.bool32(0)), + b.Assignment(j, b.i(1, return_type)), + b.While(b.iLtE(j, b.StringLen(args[1])), { + b.If(b.sEq(b.StringSection(args[0], b.i_tSub(i, b.i(1, return_type), return_type), i), + b.StringSection(args[1], b.i_tSub(j, b.i(1, return_type), return_type), j)), { + b.Assignment(matched, b.bool32(1)) + }, {}), + b.Assignment(j, b.i_tAdd(j, b.i(1, return_type), return_type)), + }), + b.If(b.boolEq(matched, b.bool32(0)), { + b.Assignment(result, i), + b.Exit(nullptr) + }, {}), + b.Assignment(i, b.i_tSub(i, b.i(1, return_type), return_type)), + }), + }, { + b.Assignment(i, b.i(1, return_type)), + b.While(b.iLtE(i, b.StringLen(args[0])), { + b.Assignment(matched, b.bool32(0)), + b.Assignment(j, b.i(1, return_type)), + b.While(b.iLtE(j, b.StringLen(args[1])), { + b.If(b.sEq(b.StringSection(args[0], b.i_tSub(i, b.i(1, return_type), return_type), i), + b.StringSection(args[1], b.i_tSub(j, b.i(1, return_type), return_type), j)), { + b.Assignment(matched, b.bool32(1)) + }, {}), + b.Assignment(j, b.i_tAdd(j, b.i(1, return_type), return_type)), + }), + b.If(b.boolEq(matched, b.bool32(0)), { + b.Assignment(result, i), + b.Exit(nullptr) + }, {}), + b.Assignment(i, b.i_tAdd(i, b.i(1, return_type), return_type)) + }), + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace StringContainsSet + +namespace StringFindSet { + + static ASR::expr_t *eval_StringFindSet(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + char* string = ASR::down_cast(args[0])->m_s; + char* set = ASR::down_cast(args[1])->m_s; + bool back = ASR::down_cast(args[2])->m_value; + int64_t kind = ASR::down_cast(args[3])->m_n; + size_t len = std::strlen(string); + int64_t result = 0; + if (back) { + for (size_t i=0; i& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_scan_" + type_to_str_python(arg_types[0])); + fill_func_arg("str", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("set", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("back", ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + fill_func_arg("kind", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + auto result = declare(fn_name, return_type, ReturnVar); + auto i = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto j = declare("j", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + /* + function StringFindSet_(string, set, back, kind) result(r) + character(len=*) :: string + character(len=*) :: set + logical, optional :: back + integer(kind) :: r = 0 + integer :: i, j + if (back) then + i = len(string) + do while (i >= 1) + j = 1 + do while (j <= len(set)) + if (string(i:i) == set(j:j)) then + r = i + exit + end if + j = j + 1 + end do + if (r /= 0) exit + i = i - 1 + end do + else + i = 1 + do while (i <= len(string)) + j = 1 + do while (j <= len(set)) + if (string(i:i) == set(j:j)) then + r = i + exit + end if + j = j + 1 + end do + if (r /= 0) exit + i = i + 1 + end do + end if + end function + */ + + body.push_back(al, b.Assignment(result, b.i(0, return_type))); + body.push_back(al, b.If(b.boolEq(args[2], b.bool32(1)), { + b.Assignment(i, b.StringLen(args[0])), + b.While(b.iGtE(i, b.i(1, return_type)), { + b.Assignment(j, b.i(1, return_type)), + b.While(b.iLtE(j, b.StringLen(args[1])), { + b.If(b.sEq(b.StringSection(args[0], b.i_tSub(i, b.i(1, return_type), return_type), i), + b.StringSection(args[1], b.i_tSub(j, b.i(1, return_type), return_type), j)), { + b.Assignment(result, i), + b.Exit(nullptr) + }, {}), + b.Assignment(j, b.i_tAdd(j, b.i(1, return_type), return_type)), + }), + b.If(b.iNotEq(result, b.i(0, return_type)), { + b.Exit(nullptr) + }, {}), + b.Assignment(i, b.i_tSub(i, b.i(1, return_type), return_type)) + }), + }, { + b.Assignment(i, b.i(1, return_type)), + b.While(b.iLtE(i, b.StringLen(args[0])), { + b.Assignment(j, b.i(1, return_type)), + b.While(b.iLtE(j, b.StringLen(args[1])), { + b.If(b.sEq(b.StringSection(args[0], b.i_tSub(i, b.i(1, return_type), return_type), i), + b.StringSection(args[1], b.i_tSub(j, b.i(1, return_type), return_type), j)), { + b.Assignment(result, i), + b.Exit(nullptr) + }, {}), + b.Assignment(j, b.i_tAdd(j, b.i(1, return_type), return_type)), + }), + b.If(b.iNotEq(result, b.i(0, return_type)), { + b.Exit(nullptr) + }, {}), + b.Assignment(i, b.i_tAdd(i, b.i(1, return_type), return_type)) + }), + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace StringFindSet + +namespace SubstrIndex { + + static ASR::expr_t *eval_SubstrIndex(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + char* string = ASR::down_cast(args[0])->m_s; + char* substring = ASR::down_cast(args[1])->m_s; + bool back = ASR::down_cast(args[2])->m_value; + int64_t kind = ASR::down_cast(args[3])->m_n; + size_t len = std::strlen(string); + int64_t result = 0; + if (back) { + for (size_t i=0; i& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_index_" + type_to_str_python(arg_types[0])); + fill_func_arg("str", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("substr", ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + fill_func_arg("back", ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + fill_func_arg("kind", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + auto idx = declare(fn_name, return_type, ReturnVar); + auto found = declare("found", arg_types[2], Local); + auto i = declare("i", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto j = declare("j", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto k = declare("k", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + auto pos = declare("pos", ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), Local); + + /* + function SubstrIndex_(string, substring, back, kind) result(r) + character(len=*) :: string + character(len=*) :: substring + logical, optional :: back + integer(kind) :: idx = 0 + integer :: i, j, k, pos, len_str, len_sub, idx + logical :: found = .true. + i = 1 + len_str = len(string) + len_sub = len(substring) + + if (len_str < len_sub) then + found = .false. + end if + + do while (i < len_str .and. found) + k = 0 + j = 1 + do while (j <= len_sub .and. found) + pos = i + k + if( string(pos:pos) /= substring(j:j) ) then + found = .false. + end if + k = k + 1 + j = j + 1 + end do + if (found) then + idx = i + if (back .eqv. .true.) then + found = .true. + else + found = .false. + end if + else + found = .true. + end if + i = i + 1 + end do + end function + */ + body.push_back(al, b.Assignment(idx, b.i(0, return_type))); + body.push_back(al, b.Assignment(i, b.i(1, return_type))); + body.push_back(al, b.Assignment(found, b.bool32(1))); + body.push_back(al, b.If(b.iLt(b.StringLen(args[0]), b.StringLen(args[1])), { + b.Assignment(found, b.bool32(0)) + }, {})); + + body.push_back(al, b.While(b.And(b.iLt(i, b.StringLen(args[0])), b.boolEq(found, b.bool32(1))), { + b.Assignment(k, b.i(0, return_type)), + b.Assignment(j, b.i(1, return_type)), + b.While(b.And(b.iLtE(j, b.StringLen(args[1])), b.boolEq(found, b.bool32(1))), { + b.Assignment(pos, b.i_tAdd(i, k, return_type)), + b.If(b.sNotEq( + b.StringSection(args[0], b.i_tSub(pos, b.i(1, return_type), return_type), pos), + b.StringSection(args[1], b.i_tSub(j, b.i(1, return_type), return_type), j)), { + b.Assignment(found, b.bool32(0)) + }, {}), + b.Assignment(j, b.i_tAdd(j, b.i(1, return_type), return_type)), + b.Assignment(k, b.i_tAdd(k, b.i(1, return_type), return_type)), + }), + b.If(b.boolEq(found, b.bool32(1)), { + b.Assignment(idx, i), + b.Assignment(found, args[2]) + }, { + b.Assignment(found, b.bool32(1)) + }), + b.Assignment(i, b.i_tAdd(i, b.i(1, return_type), return_type)), + })); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, idx, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace SubstrIndex + +namespace MinExponent { + + static ASR::expr_t *eval_MinExponent(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + ASR::RealConstant_t* a = ASR::down_cast(args[0]); + int m_kind = ASRUtils::extract_kind_from_ttype_t(a->m_type); + int result; + if (m_kind == 4) { + result = std::numeric_limits::min_exponent; + } else { + result = std::numeric_limits::min_exponent; + } + return make_ConstantWithType(make_IntegerConstant_t, result, int32, loc); + + } + + static inline ASR::expr_t* instantiate_MinExponent(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_minexponent_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, int32, ReturnVar); + + int m_kind = ASRUtils::extract_kind_from_ttype_t(arg_types[0]); + if (m_kind == 4) { + body.push_back(al, b.Assignment(result, b.i32(-125))); + } else { + body.push_back(al, b.Assignment(result, b.i32(-1021))); + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace MinExponent + +namespace MaxExponent { + + static ASR::expr_t *eval_MaxExponent(Allocator &al, const Location &loc, + ASR::ttype_t* /*t1*/, Vec &args, diag::Diagnostics& /*diag*/) { + ASR::RealConstant_t* a = ASR::down_cast(args[0]); + int m_kind = ASRUtils::extract_kind_from_ttype_t(a->m_type); + int result; + if (m_kind == 4) { + result = std::numeric_limits::max_exponent; + } else { + result = std::numeric_limits::max_exponent; + } + return make_ConstantWithType(make_IntegerConstant_t, result, int32, loc); + + } + + static inline ASR::expr_t* instantiate_MaxExponent(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_optimization_maxexponent_" + type_to_str_python(arg_types[0])); + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, int32, ReturnVar); + + int m_kind = ASRUtils::extract_kind_from_ttype_t(arg_types[0]); + if (m_kind == 4) { + body.push_back(al, b.Assignment(result, b.i32(128))); + } else { + body.push_back(al, b.Assignment(result, b.i32(1024))); + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace MaxExponent + +#define create_exp_macro(X, stdeval) \ +namespace X { \ + static inline ASR::expr_t* eval_##X(Allocator &al, const Location &loc, \ + ASR::ttype_t *t, Vec &args, diag::Diagnostics& /*diag*/) { \ + LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); \ + double rv = -1; \ + if( ASRUtils::extract_value(args[0], rv) ) { \ + double val = std::stdeval(rv); \ + return ASRUtils::EXPR(ASR::make_RealConstant_t(al, loc, val, t)); \ + } \ + return nullptr; \ + } \ + static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ + Vec& args, \ + diag::Diagnostics& diag) { \ + if (args.size() != 1) { \ + append_error(diag, "Intrinsic function `"#X"` accepts exactly 1 argument", \ + loc); \ + return nullptr; \ + } \ + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); \ + if (!ASRUtils::is_real(*type)) { \ + append_error(diag, "Argument of the `"#X"` function must be either Real", \ + args[0]->base.loc); \ + return nullptr; \ + } \ + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_##X, \ + static_cast(IntrinsicElementalFunctions::X), 0, type, diag); \ + } \ +} // namespace X + +create_exp_macro(Exp2, exp2) +create_exp_macro(Expm1, expm1) + +namespace Exp { + + static inline ASR::expr_t* eval_Exp(Allocator &al, const Location &loc, + ASR::ttype_t *t, Vec &args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); + double rv = -1; + if( ASRUtils::extract_value(args[0], rv) ) { + double val = std::exp(rv); + return ASRUtils::EXPR(ASR::make_RealConstant_t(al, loc, val, t)); + } else { + std::complex crv; + if( ASRUtils::extract_value(args[0], crv) ) { + std::complex val = std::exp(crv); + return ASRUtils::EXPR(ASR::make_ComplexConstant_t( + al, loc, val.real(), val.imag(), t)); + } + } + return nullptr; + } + + static inline ASR::asr_t* create_Exp(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 1) { + append_error(diag, "Intrinsic function `exp` accepts exactly 1 argument", loc); + return nullptr; + } + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); + if (!ASRUtils::is_real(*type) && !is_complex(*type)) { + append_error(diag, "Argument of the `exp` function must be either Real or Complex", + args[0]->base.loc); + return nullptr; + } + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, + eval_Exp, static_cast(IntrinsicElementalFunctions::Exp), + 0, type, diag); + } + + static inline ASR::expr_t* instantiate_Exp(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t overload_id) { + if (is_real(*arg_types[0])) { + Vec args; args.reserve(al, 1); + args.push_back(al, new_args[0].m_value); + return EXPR(ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::Exp), + args.p, 1, overload_id, return_type, nullptr)); + } else { + return UnaryIntrinsicFunction::instantiate_functions(al, loc, scope, + "exp", arg_types[0], return_type, new_args, overload_id); + } + } + +} // namespace Exp + +namespace ListIndex { + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args <= 4, "Call to list.index must have at most four arguments", + x.base.base.loc, diagnostics); + ASR::ttype_t* arg0_type = ASRUtils::type_get_past_const(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl(ASR::is_a(*arg0_type) && + ASRUtils::check_equal_type(ASRUtils::expr_type(x.m_args[1]), ASRUtils::get_contained_type(arg0_type)), + "First argument to list.index must be of list type and " + "second argument must be of same type as list elemental type", + x.base.base.loc, diagnostics); + if(x.n_args >= 3) { + ASRUtils::require_impl( + ASR::is_a(*ASRUtils::expr_type(x.m_args[2])), + "Third argument to list.index must be an integer", + x.base.base.loc, diagnostics); + } + if(x.n_args == 4) { + ASRUtils::require_impl( + ASR::is_a(*ASRUtils::expr_type(x.m_args[3])), + "Fourth argument to list.index must be an integer", + x.base.base.loc, diagnostics); + } + ASRUtils::require_impl(ASR::is_a(*x.m_type), + "Return type of list.index must be an integer", + x.base.base.loc, diagnostics); +} + +static inline ASR::expr_t *eval_list_index(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for ListConstant expression + return nullptr; +} + + +static inline ASR::asr_t* create_ListIndex(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + int64_t overload_id = 0; + ASR::expr_t* list_expr = args[0]; + ASR::ttype_t *type = ASRUtils::expr_type(list_expr); + ASR::ttype_t *list_type = ASR::down_cast(ASRUtils::type_get_past_const(type))->m_type; + ASR::ttype_t *ele_type = ASRUtils::expr_type(args[1]); + if (!ASRUtils::check_equal_type(ele_type, list_type)) { + std::string fnd = ASRUtils::get_type_code(ele_type); + std::string org = ASRUtils::get_type_code(list_type); + append_error(diag, + "Type mismatch in 'index', the types must be compatible " + "(found: '" + fnd + "', expected: '" + org + "')", loc); + return nullptr; + } + if (args.size() >= 3) { + overload_id = 1; + if(!ASR::is_a(*ASRUtils::expr_type(args[2]))) { + append_error(diag, "Third argument to list.index must be an integer", loc); + return nullptr; + } + } + if (args.size() == 4) { + overload_id = 2; + if(!ASR::is_a(*ASRUtils::expr_type(args[3]))) { + append_error(diag, "Fourth argument to list.index must be an integer", loc); + return nullptr; + } + } + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + ASR::ttype_t *to_type = int32; + ASR::expr_t* compile_time_value = eval_list_index(al, loc, to_type, arg_values, diag); + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::ListIndex), + args.p, args.size(), overload_id, to_type, compile_time_value); +} + +} // namespace ListIndex + +namespace ListReverse { + +static inline ASR::expr_t *eval_ListReverse(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for ListConstant expression + return nullptr; +} + +} // namespace ListReverse + +namespace ListPop { + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args <= 2, "Call to list.pop must have at most one argument", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), + "Argument to list.pop must be of list type", + x.base.base.loc, diagnostics); + switch(x.m_overload_id) { + case 0: + break; + case 1: + ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[1])), + "Argument to list.pop must be an integer", + x.base.base.loc, diagnostics); + break; + } + ASRUtils::require_impl(ASRUtils::check_equal_type(x.m_type, + ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), + "Return type of list.pop must be of same type as list's element type", + x.base.base.loc, diagnostics); +} + +static inline ASR::expr_t *eval_list_pop(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t */*t*/, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for ListConstant expression + return nullptr; +} + +static inline ASR::asr_t* create_ListPop(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() > 2) { + append_error(diag, "Call to list.pop must have at most one argument", loc); + return nullptr; + } + if (args.size() == 2 && + !ASR::is_a(*ASRUtils::expr_type(args[1]))) { + append_error(diag, "Argument to list.pop must be an integer", loc); + return nullptr; + } + + ASR::expr_t* list_expr = args[0]; + ASR::ttype_t *type = ASRUtils::expr_type(list_expr); + ASR::ttype_t *list_type = ASR::down_cast(type)->m_type; + + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + ASR::ttype_t *to_type = list_type; + ASR::expr_t* compile_time_value = eval_list_pop(al, loc, to_type, arg_values, diag); + int64_t overload_id = (args.size() == 2); + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::ListPop), + args.p, args.size(), overload_id, to_type, compile_time_value); +} + +} // namespace ListPop + +namespace ListReserve { + +static inline ASR::expr_t *eval_ListReserve(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for ListConstant expression + return nullptr; +} + +} // namespace ListReserve + +namespace DictKeys { + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 1, "Call to dict.keys must have no argument", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), + "Argument to dict.keys must be of dict type", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*x.m_type) && + ASRUtils::check_equal_type(ASRUtils::get_contained_type(x.m_type), + ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]), 0)), + "Return type of dict.keys must be of list of dict key element type", + x.base.base.loc, diagnostics); +} + +static inline ASR::expr_t *eval_dict_keys(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for DictConstant expression + return nullptr; +} + +static inline ASR::asr_t* create_DictKeys(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 1) { + append_error(diag, "Call to dict.keys must have no argument", loc); + return nullptr; + } + + ASR::expr_t* dict_expr = args[0]; + ASR::ttype_t *type = ASRUtils::expr_type(dict_expr); + ASR::ttype_t *dict_keys_type = ASR::down_cast(type)->m_key_type; + + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + ASR::ttype_t *to_type = List(dict_keys_type); + ASR::expr_t* compile_time_value = eval_dict_keys(al, loc, to_type, arg_values, diag); + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::DictKeys), + args.p, args.size(), 0, to_type, compile_time_value); +} + +} // namespace DictKeys + +namespace DictValues { + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 1, "Call to dict.values must have no argument", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), + "Argument to dict.values must be of dict type", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*x.m_type) && + ASRUtils::check_equal_type(ASRUtils::get_contained_type(x.m_type), + ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]), 1)), + "Return type of dict.values must be of list of dict value element type", + x.base.base.loc, diagnostics); +} + +static inline ASR::expr_t *eval_dict_values(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for DictConstant expression + return nullptr; +} + +static inline ASR::asr_t* create_DictValues(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 1) { + append_error(diag, "Call to dict.values must have no argument", loc); + return nullptr; + } + + ASR::expr_t* dict_expr = args[0]; + ASR::ttype_t *type = ASRUtils::expr_type(dict_expr); + ASR::ttype_t *dict_values_type = ASR::down_cast(type)->m_value_type; + + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + ASR::ttype_t *to_type = List(dict_values_type); + ASR::expr_t* compile_time_value = eval_dict_values(al, loc, to_type, arg_values, diag); + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::DictValues), + args.p, args.size(), 0, to_type, compile_time_value); +} + +} // namespace DictValues + +namespace SetAdd { + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 2, "Call to set.add must have exactly one argument", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), + "First argument to set.add must be of set type", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASRUtils::check_equal_type(ASRUtils::expr_type(x.m_args[1]), + ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), + "Second argument to set.add must be of same type as set's element type", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(x.m_type == nullptr, + "Return type of set.add must be empty", + x.base.base.loc, diagnostics); +} + +static inline ASR::expr_t *eval_set_add(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for SetConstant expression + return nullptr; +} + +static inline ASR::asr_t* create_SetAdd(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 2) { + append_error(diag, "Call to set.add must have exactly one argument", loc); + return nullptr; + } + if (!ASRUtils::check_equal_type(ASRUtils::expr_type(args[1]), + ASRUtils::get_contained_type(ASRUtils::expr_type(args[0])))) { + append_error(diag, "Argument to set.add must be of same type as set's " + "element type", loc); + return nullptr; + } + + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + ASR::expr_t* compile_time_value = eval_set_add(al, loc, nullptr, arg_values, diag); + return ASR::make_Expr_t(al, loc, + ASRUtils::EXPR(ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::SetAdd), + args.p, args.size(), 0, nullptr, compile_time_value))); +} + +} // namespace SetAdd + +namespace SetRemove { + +static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 2, "Call to set.remove must have exactly one argument", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*ASRUtils::expr_type(x.m_args[0])), + "First argument to set.remove must be of set type", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASRUtils::check_equal_type(ASRUtils::expr_type(x.m_args[1]), + ASRUtils::get_contained_type(ASRUtils::expr_type(x.m_args[0]))), + "Second argument to set.remove must be of same type as set's element type", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(x.m_type == nullptr, + "Return type of set.remove must be empty", + x.base.base.loc, diagnostics); +} + +static inline ASR::expr_t *eval_set_remove(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO: To be implemented for SetConstant expression + return nullptr; +} + +static inline ASR::asr_t* create_SetRemove(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 2) { + append_error(diag, "Call to set.remove must have exactly one argument", loc); + return nullptr; + } + if (!ASRUtils::check_equal_type(ASRUtils::expr_type(args[1]), + ASRUtils::get_contained_type(ASRUtils::expr_type(args[0])))) { + append_error(diag, "Argument to set.remove must be of same type as set's " + "element type", loc); + return nullptr; + } + + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + ASR::expr_t* compile_time_value = eval_set_remove(al, loc, nullptr, arg_values, diag); + return ASR::make_Expr_t(al, loc, + ASRUtils::EXPR(ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::SetRemove), + args.p, args.size(), 0, nullptr, compile_time_value))); +} + +} // namespace SetRemove + +namespace Max { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args > 1, "Call to max0 must have at least two arguments", + x.base.base.loc, diagnostics); + ASR::ttype_t* arg0_type = ASRUtils::type_get_past_array(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl(ASR::is_a(*arg0_type) || + ASR::is_a(*arg0_type) || ASR::is_a(*arg0_type), + "Arguments to max0 must be of real, integer or character type", + x.base.base.loc, diagnostics); + for(size_t i=0;i(*ASRUtils::expr_type(x.m_args[i])) && + ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))) || + (ASR::is_a(*ASRUtils::expr_type(x.m_args[i])) && + ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))) || + (ASR::is_a(*ASRUtils::expr_type(x.m_args[i])) && + ASR::is_a(*ASRUtils::expr_type(x.m_args[0]))), + "All arguments must be of the same type", + x.base.base.loc, diagnostics); + } + } + + static ASR::expr_t *eval_Max(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); + if (ASR::is_a(*arg_type)) { + double max_val = ASR::down_cast(args[0])->m_r; + for (size_t i = 1; i < args.size(); i++) { + double val = ASR::down_cast(args[i])->m_r; + max_val = std::fmax(max_val, val); + } + return ASR::down_cast(ASR::make_RealConstant_t(al, loc, max_val, arg_type)); + } else if (ASR::is_a(*arg_type)) { + int64_t max_val = ASR::down_cast(args[0])->m_n; + for (size_t i = 1; i < args.size(); i++) { + int64_t val = ASR::down_cast(args[i])->m_n; + max_val = std::fmax(max_val, val); + } + return ASR::down_cast(ASR::make_IntegerConstant_t(al, loc, max_val, arg_type)); + } else if (ASR::is_a(*arg_type)) { + char* max_val = ASR::down_cast(args[0])->m_s; + for (size_t i = 1; i < args.size(); i++) { + char* val = ASR::down_cast(args[i])->m_s; + if (strcmp(val, max_val) > 0) { + max_val = val; + } + } + return ASR::down_cast(ASR::make_StringConstant_t(al, loc, max_val, arg_type)); + } else { + return nullptr; + } + } + + static inline ASR::asr_t* create_Max( + Allocator& al, const Location& loc, Vec& args, + diag::Diagnostics& diag) { + bool is_compile_time = true; + for(size_t i=0; i<100;i++){ + args.erase(nullptr); + } + if (args.size() < 2) { + append_error(diag, "Intrinsic max0 must have 2 arguments", loc); + return nullptr; + } + ASR::ttype_t *arg_type = ASRUtils::expr_type(args[0]); + for(size_t i=0;i arg_values; + arg_values.reserve(al, args.size()); + ASR::expr_t *arg_value; + for(size_t i=0;i(IntrinsicElementalFunctions::Max), + args.p, args.n, 0, ASRUtils::expr_type(args[0]), value); + } else { + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::Max), + args.p, args.n, 0, ASRUtils::expr_type(args[0]), nullptr); + } + } + + static inline ASR::expr_t* instantiate_Max(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_max0_" + type_to_str_python(arg_types[0])); + int64_t kind = extract_kind_from_ttype_t(arg_types[0]); + if (ASR::is_a(*arg_types[0])) { + for (size_t i = 0; i < new_args.size(); i++) { + fill_func_arg("x" + std::to_string(i), ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + } + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, args[0], int32, nullptr)))); + } else if (ASR::is_a(*arg_types[0])) { + for (size_t i = 0; i < new_args.size(); i++) { + fill_func_arg("x" + std::to_string(i), ASRUtils::TYPE(ASR::make_Real_t(al, loc, kind))); + } + } else if (ASR::is_a(*arg_types[0])) { + for (size_t i = 0; i < new_args.size(); i++) { + fill_func_arg("x" + std::to_string(i), ASRUtils::TYPE(ASR::make_Integer_t(al, loc, kind))); + } + } else { + throw LCompilersException("Arguments to max0 must be of real, integer or character type"); + } + + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, args[0])); + if (ASR::is_a(*return_type)) { + for (size_t i = 1; i < args.size(); i++) { + body.push_back(al, b.If(b.iGt(args[i], result), { + b.Assignment(result, args[i]) + }, {})); + } + } else if (ASR::is_a(*return_type)) { + for (size_t i = 1; i < args.size(); i++) { + body.push_back(al, b.If(b.fGt(args[i], result), { + b.Assignment(result, args[i]) + }, {})); + } + } else if (ASR::is_a(*return_type)) { + for (size_t i = 1; i < args.size(); i++) { + body.push_back(al, b.If(b.sGt(args[i], result), { + b.Assignment(result, args[i]) + }, {})); + } + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, new_args[0].m_value, int32, nullptr)))); + } else { + throw LCompilersException("Arguments to max0 must be of real, integer or character type"); + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Max + +namespace Min { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args > 1, "Call to min0 must have at least two arguments", + x.base.base.loc, diagnostics); + ASR::ttype_t* arg0_type = ASRUtils::type_get_past_array(ASRUtils::expr_type(x.m_args[0])); + ASRUtils::require_impl(ASR::is_a(*arg0_type) || + ASR::is_a(*arg0_type) || ASR::is_a(*arg0_type), + "Arguments to min0 must be of real, integer or character type", + x.base.base.loc, diagnostics); + for(size_t i=0;i(*arg_type) && ASR::is_a(*arg0_type)) || + (ASR::is_a(*arg_type) && ASR::is_a(*arg0_type)) || + (ASR::is_a(*arg_type) && ASR::is_a(*arg0_type) ), + "All arguments must be of the same type", + x.base.base.loc, diagnostics); + } + } + + static ASR::expr_t *eval_Min(Allocator &al, const Location &loc, + ASR::ttype_t *arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + LCOMPILERS_ASSERT(ASRUtils::all_args_evaluated(args)); + if (ASR::is_a(*arg_type)) { + double min_val = ASR::down_cast(args[0])->m_r; + for (size_t i = 1; i < args.size(); i++) { + double val = ASR::down_cast(args[i])->m_r; + min_val = std::fmin(min_val, val); + } + return ASR::down_cast(ASR::make_RealConstant_t(al, loc, min_val, arg_type)); + } else if (ASR::is_a(*arg_type)) { + int64_t min_val = ASR::down_cast(args[0])->m_n; + for (size_t i = 1; i < args.size(); i++) { + int64_t val = ASR::down_cast(args[i])->m_n; + min_val = std::fmin(min_val, val); + } + return ASR::down_cast(ASR::make_IntegerConstant_t(al, loc, min_val, arg_type)); + } else if (ASR::is_a(*arg_type)) { + char* min_val = ASR::down_cast(args[0])->m_s; + for (size_t i = 1; i < args.size(); i++) { + char* val = ASR::down_cast(args[i])->m_s; + if (strcmp(val, min_val) < 0) { + min_val = val; + } + } + return ASR::down_cast(ASR::make_StringConstant_t(al, loc, min_val, arg_type)); + } else { + return nullptr; + } + } + + static inline ASR::asr_t* create_Min( + Allocator& al, const Location& loc, Vec& args, + diag::Diagnostics& diag) { + bool is_compile_time = true; + for(size_t i=0; i<100;i++){ + args.erase(nullptr); + } + if (args.size() < 2) { + append_error(diag, "Intrinsic min0 must have 2 arguments", loc); + return nullptr; + } + ASR::ttype_t *arg_type = ASRUtils::expr_type(args[0]); + for(size_t i=0;i arg_values; + arg_values.reserve(al, args.size()); + ASR::expr_t *arg_value; + for(size_t i=0;i(IntrinsicElementalFunctions::Min), + args.p, args.n, 0, ASRUtils::expr_type(args[0]), value); + } else { + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::Min), + args.p, args.n, 0, ASRUtils::expr_type(args[0]), nullptr); + } + } + + static inline ASR::expr_t* instantiate_Min(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + declare_basic_variables("_lcompilers_min0_" + type_to_str_python(arg_types[0])); + int64_t kind = extract_kind_from_ttype_t(arg_types[0]); + if (ASR::is_a(*arg_types[0])) { + for (size_t i = 0; i < new_args.size(); i++) { + fill_func_arg("x" + std::to_string(i), ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -1, nullptr))); + } + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, args[0], int32, nullptr)))); + } else if (ASR::is_a(*arg_types[0])) { + for (size_t i = 0; i < new_args.size(); i++) { + fill_func_arg("x" + std::to_string(i), ASRUtils::TYPE(ASR::make_Real_t(al, loc, kind))); + } + } else if (ASR::is_a(*arg_types[0])) { + for (size_t i = 0; i < new_args.size(); i++) { + fill_func_arg("x" + std::to_string(i), ASRUtils::TYPE(ASR::make_Integer_t(al, loc, kind))); + } + } else { + throw LCompilersException("Arguments to min0 must be of real, integer or character type"); + } + + auto result = declare(fn_name, return_type, ReturnVar); + body.push_back(al, b.Assignment(result, args[0])); + if (ASR::is_a(*return_type)) { + for (size_t i = 1; i < args.size(); i++) { + body.push_back(al, b.If(b.iLt(args[i], result), { + b.Assignment(result, args[i]) + }, {})); + } + } else if (ASR::is_a(*return_type)) { + for (size_t i = 1; i < args.size(); i++) { + body.push_back(al, b.If(b.fLt(args[i], result), { + b.Assignment(result, args[i]) + }, {})); + } + } else if (ASR::is_a(*return_type)) { + for (size_t i = 1; i < args.size(); i++) { + body.push_back(al, b.If(b.sLt(args[i], result), { + b.Assignment(result, args[i]) + }, {})); + } + return_type = TYPE(ASR::make_Character_t(al, loc, 1, -3, EXPR(ASR::make_StringLen_t(al, loc, new_args[0].m_value, int32, nullptr)))); + } else { + throw LCompilersException("Arguments to min0 must be of real, integer or character type"); + } + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, return_type, nullptr); + } + +} // namespace Min + +namespace Partition { + + static inline ASR::expr_t* eval_Partition(Allocator &al, const Location &loc, + std::string &s_var, std::string &sep) { + /* + using KMP algorithm to find separator inside string + res_tuple: stores the resulting 3-tuple expression ---> + (if separator exist) tuple: (left of separator, separator, right of separator) + (if separator does not exist) tuple: (string, "", "") + res_tuple_type: stores the type of each expression present in resulting 3-tuple + */ + ASRBuilder b(al, loc); + int sep_pos = ASRUtils::KMP_string_match(s_var, sep); + std::string first_res, second_res, third_res; + if(sep_pos == -1) { + /* seperator does not exist */ + first_res = s_var; + second_res = ""; + third_res = ""; + } else { + first_res = s_var.substr(0, sep_pos); + second_res = sep; + third_res = s_var.substr(sep_pos + sep.size()); + } + + Vec res_tuple; res_tuple.reserve(al, 3); + ASR::ttype_t *first_res_type = character(first_res.size()); + ASR::ttype_t *second_res_type = character(second_res.size()); + ASR::ttype_t *third_res_type = character(third_res.size()); + return b.TupleConstant({ b.StringConstant(first_res, first_res_type), + b.StringConstant(second_res, second_res_type), + b.StringConstant(third_res, third_res_type) }, + b.Tuple({first_res_type, second_res_type, third_res_type})); + } + + static inline ASR::asr_t *create_partition(Allocator &al, const Location &loc, + Vec &args, ASR::expr_t *s_var, + diag::Diagnostics& diag) { + ASRBuilder b(al, loc); + if (args.size() != 1) { + append_error(diag, "str.partition() takes exactly one argument", loc); + return nullptr; + } + ASR::expr_t *arg = args[0]; + if (!ASRUtils::is_character(*expr_type(arg))) { + append_error(diag, "str.partition() takes one arguments of type: str", arg->base.loc); + return nullptr; + } + + Vec e_args; e_args.reserve(al, 2); + e_args.push_back(al, s_var); + e_args.push_back(al, arg); + + ASR::ttype_t *return_type = b.Tuple({character(-2), character(-2), character(-2)}); + ASR::expr_t *value = nullptr; + if (ASR::is_a(*s_var) + && ASR::is_a(*arg)) { + std::string s_sep = ASR::down_cast(arg)->m_s; + std::string s_str = ASR::down_cast(s_var)->m_s; + if (s_sep.size() == 0) { + append_error(diag, "Separator cannot be an empty string", arg->base.loc); + return nullptr; + } + value = eval_Partition(al, loc, s_str, s_sep); + } + + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::Partition), + e_args.p, e_args.n, 0, return_type, value); + } + + static inline ASR::expr_t *instantiate_Partition(Allocator &al, + const Location &loc, SymbolTable *scope, + Vec& /*arg_types*/, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + // TODO: show runtime error for empty separator or pattern + declare_basic_variables("_lpython_str_partition"); + fill_func_arg("target_string", character(-2)); + fill_func_arg("pattern", character(-2)); + + auto result = declare("result", return_type, ReturnVar); + auto index = declare("index", int32, Local); + body.push_back(al, b.Assignment(index, b.Call(UnaryIntrinsicFunction:: + create_KMP_function(al, loc, scope), args, int32))); + body.push_back(al, b.If(b.iEq(index, b.i32_n(-1)), { + b.Assignment(result, b.TupleConstant({ args[0], + b.StringConstant("", character(0)), + b.StringConstant("", character(0)) }, + b.Tuple({character(-2), character(0), character(0)}))) + }, { + b.Assignment(result, b.TupleConstant({ + b.StringSection(args[0], b.i32(0), index), args[1], + b.StringSection(args[0], b.iAdd(index, b.StringLen(args[1])), + b.StringLen(args[0]))}, return_type)) + })); + body.push_back(al, Return()); + ASR::symbol_t *fn_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, fn_sym); + return b.Call(fn_sym, new_args, return_type, nullptr); + } + +} // namespace Partition + +namespace Epsilon { + + static ASR::expr_t *eval_Epsilon(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + double epsilon_val = -1; + ASRUtils::ASRBuilder b(al, loc); + int32_t kind = extract_kind_from_ttype_t(arg_type); + switch ( kind ) { + case 4: { + epsilon_val = std::numeric_limits::epsilon(); break; + } case 8: { + epsilon_val = std::numeric_limits::epsilon(); break; + } default: { + break; + } + } + return b.f(epsilon_val, arg_type); + } + +} // namespace Epsilon + +namespace Precision { + + static ASR::expr_t *eval_Precision(Allocator &al, const Location &loc, + ASR::ttype_t* /*return_type*/, Vec &args, diag::Diagnostics& diag) { + int64_t precision_val = -1; + ASRUtils::ASRBuilder b(al, loc); + ASR::ttype_t *arg_type = expr_type(args[0]); + int32_t kind = extract_kind_from_ttype_t(arg_type); + switch ( kind ) { + case 4: { + precision_val = 6; break; + } case 8: { + precision_val = 15; break; + } default: { + append_error(diag, "Kind " + std::to_string(kind) + " is not supported yet", loc); + return nullptr; + } + } + return b.i32(precision_val); + } + +} // namespace Precision + +namespace Tiny { + + static ASR::expr_t *eval_Tiny(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &/*args*/, diag::Diagnostics& diag) { + double tiny_value = -1; + ASRUtils::ASRBuilder b(al, loc); + int32_t kind = extract_kind_from_ttype_t(arg_type); + switch ( kind ) { + case 4: { + tiny_value = std::numeric_limits::min(); break; + } case 8: { + tiny_value = std::numeric_limits::min(); break; + } default: { + append_error(diag, "Kind " + std::to_string(kind) + " is not supported yet", loc); + return nullptr; + } + } + return b.f(tiny_value, arg_type); + } + +} // namespace Tiny + +namespace Conjg { + + static ASR::expr_t *eval_Conjg(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &args, diag::Diagnostics& /*diag*/) { + std::complex crv; + if( extract_value(args[0], crv) ) { + std::complex val = std::conj(crv); + return EXPR(ASR::make_ComplexConstant_t( + al, loc, val.real(), val.imag(), arg_type)); + } else { + return nullptr; + } + } + + static inline ASR::expr_t* instantiate_Conjg(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, ASR::ttype_t *return_type, + Vec& new_args, int64_t /*overload_id*/) { + std::string func_name = "_lcompilers_conjg_" + type_to_str_python(arg_types[0]); + declare_basic_variables(func_name); + if (scope->get_symbol(func_name)) { + ASR::symbol_t *s = scope->get_symbol(func_name); + ASR::Function_t *f = ASR::down_cast(s); + return b.Call(s, new_args, expr_type(f->m_return_var), nullptr); + } + fill_func_arg("x", arg_types[0]); + auto result = declare(fn_name, arg_types[0], ReturnVar); + // * r = real(x) - aimag(x)*(0,1) + + body.push_back(al, b.Assignment(result, b.ElementalSub( + EXPR(ASR::make_Cast_t(al, loc, EXPR(ASR::make_ComplexRe_t(al, loc, + args[0], TYPE(ASR::make_Real_t(al, loc, extract_kind_from_ttype_t(arg_types[0]))), nullptr)), + ASR::cast_kindType::RealToComplex, arg_types[0], nullptr)), + b.ElementalMul(EXPR(ASR::make_Cast_t(al, loc, EXPR(ASR::make_ComplexIm_t(al, loc, + args[0], TYPE(ASR::make_Real_t(al, loc, extract_kind_from_ttype_t(arg_types[0]))), nullptr)), + ASR::cast_kindType::RealToComplex, arg_types[0], nullptr)), EXPR(ASR::make_ComplexConstant_t(al, loc, + 0.0, 1.0, arg_types[0])), loc), loc))); + + ASR::symbol_t *f_sym = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, result, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, f_sym); + return b.Call(f_sym, new_args, ASRUtils::extract_type(return_type), nullptr); + } + +} // namespace Conjg + +namespace Huge { + + static ASR::expr_t *eval_Huge(Allocator &al, const Location &loc, + ASR::ttype_t* arg_type, Vec &/*args*/, diag::Diagnostics& diag) { + ASRUtils::ASRBuilder b(al, loc); + int32_t kind = extract_kind_from_ttype_t(arg_type); + if (ASR::is_a(*arg_type)) { + int64_t huge_value = -1; + switch ( kind ) { + case 1: { + huge_value = std::numeric_limits::max(); break; + } case 2: { + huge_value = std::numeric_limits::max(); break; + } case 4: { + huge_value = std::numeric_limits::max(); break; + } case 8: { + huge_value = std::numeric_limits::max(); break; + } default: { + append_error(diag, "Kind " + std::to_string(kind) + " is not supported yet", loc); + return nullptr; + } + } + return b.i(huge_value, arg_type); + } else { + double huge_value = -1; + switch ( kind ) { + case 4: { + huge_value = std::numeric_limits::max(); break; + } case 8: { + huge_value = std::numeric_limits::max(); break; + } default: { + append_error(diag, "Kind " + std::to_string(kind) + " is not supported yet", loc); + return nullptr; + } + } + return b.f(huge_value, arg_type); + } + } + +} // namespace Huge + +namespace SymbolicSymbol { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + const Location& loc = x.base.base.loc; + ASRUtils::require_impl(x.n_args == 1, + "SymbolicSymbol intrinsic must have exactly 1 input argument", + loc, diagnostics); + + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); + ASRUtils::require_impl(ASR::is_a(*input_type), + "SymbolicSymbol intrinsic expects a character input argument", + loc, diagnostics); + } + + static inline ASR::expr_t *eval_SymbolicSymbol(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO + return nullptr; + } + + static inline ASR::asr_t* create_SymbolicSymbol(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + if (args.size() != 1) { + append_error(diag, "Intrinsic Symbol function accepts exactly 1 argument", loc); + return nullptr; + } + + ASR::ttype_t *type = ASRUtils::expr_type(args[0]); + if (!ASRUtils::is_character(*type)) { + append_error(diag, "Argument of the Symbol function must be a Character", + args[0]->base.loc); + return nullptr; + } + + ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_SymbolicSymbol, + static_cast(IntrinsicElementalFunctions::SymbolicSymbol), 0, to_type, diag); + } + +} // namespace SymbolicSymbol + +#define create_symbolic_binary_macro(X) \ +namespace X{ \ + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, \ + diag::Diagnostics& diagnostics) { \ + ASRUtils::require_impl(x.n_args == 2, "Intrinsic function `"#X"` accepts" \ + "exactly 2 arguments", x.base.base.loc, diagnostics); \ + \ + ASR::ttype_t* left_type = ASRUtils::expr_type(x.m_args[0]); \ + ASR::ttype_t* right_type = ASRUtils::expr_type(x.m_args[1]); \ + \ + ASRUtils::require_impl(ASR::is_a(*left_type) && \ + ASR::is_a(*right_type), \ + "Both arguments of `"#X"` must be of type SymbolicExpression", \ + x.base.base.loc, diagnostics); \ + } \ + \ + static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ + ASR::ttype_t *, Vec &/*args*/, diag::Diagnostics& /*diag*/) { \ + /*TODO*/ \ + return nullptr; \ + } \ + \ + static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ + Vec& args, \ + diag::Diagnostics& diag) { \ + if (args.size() != 2) { \ + append_error(diag, "Intrinsic function `"#X"` accepts exactly 2 arguments", \ + loc); \ + return nullptr; \ + } \ + \ + for (size_t i = 0; i < args.size(); i++) { \ + ASR::ttype_t* argtype = ASRUtils::expr_type(args[i]); \ + if(!ASR::is_a(*argtype)) { \ + append_error(diag, \ + "Arguments of `"#X"` function must be of type SymbolicExpression", \ + args[i]->base.loc); \ + return nullptr; \ + } \ + } \ + \ + Vec arg_values; \ + arg_values.reserve(al, args.size()); \ + for( size_t i = 0; i < args.size(); i++ ) { \ + arg_values.push_back(al, ASRUtils::expr_value(args[i])); \ + } \ + ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); \ + ASR::expr_t* compile_time_value = eval_##X(al, loc, to_type, arg_values, diag); \ + return ASR::make_IntrinsicElementalFunction_t(al, loc, \ + static_cast(IntrinsicElementalFunctions::X), \ + args.p, args.size(), 0, to_type, compile_time_value); \ + } \ +} // namespace X + +create_symbolic_binary_macro(SymbolicAdd) +create_symbolic_binary_macro(SymbolicSub) +create_symbolic_binary_macro(SymbolicMul) +create_symbolic_binary_macro(SymbolicDiv) +create_symbolic_binary_macro(SymbolicPow) +create_symbolic_binary_macro(SymbolicDiff) + +#define create_symbolic_constants_macro(X) \ +namespace X { \ + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, \ + diag::Diagnostics& diagnostics) { \ + const Location& loc = x.base.base.loc; \ + ASRUtils::require_impl(x.n_args == 0, \ + #X " does not take arguments", loc, diagnostics); \ + } \ + \ + static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ + ASR::ttype_t *, Vec &/*args*/, diag::Diagnostics& /*diag*/) { \ + /*TODO*/ \ + return nullptr; \ + } \ + \ + static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ + Vec& args, \ + diag::Diagnostics& diag) { \ + ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); \ + ASR::expr_t* compile_time_value = eval_##X(al, loc, to_type, args, diag); \ + return ASR::make_IntrinsicElementalFunction_t(al, loc, \ + static_cast(IntrinsicElementalFunctions::X), \ + nullptr, 0, 0, to_type, compile_time_value); \ + } \ +} // namespace X + +create_symbolic_constants_macro(SymbolicPi) +create_symbolic_constants_macro(SymbolicE) + +namespace SymbolicInteger { + + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 1, + "SymbolicInteger intrinsic must have exactly 1 input argument", + x.base.base.loc, diagnostics); + + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); + ASRUtils::require_impl(ASR::is_a(*input_type), + "SymbolicInteger intrinsic expects an integer input argument", + x.base.base.loc, diagnostics); + } + + static inline ASR::expr_t* eval_SymbolicInteger(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec& /*args*/, diag::Diagnostics& /*diag*/) { + // TODO + return nullptr; + } + + static inline ASR::asr_t* create_SymbolicInteger(Allocator& al, const Location& loc, + Vec& args, + diag::Diagnostics& diag) { + ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_SymbolicInteger, + static_cast(IntrinsicElementalFunctions::SymbolicInteger), 0, to_type, diag); + } + +} // namespace SymbolicInteger + +namespace SymbolicHasSymbolQ { + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, + diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 2, "Intrinsic function SymbolicHasSymbolQ" + "accepts exactly 2 arguments", x.base.base.loc, diagnostics); + + ASR::ttype_t* left_type = ASRUtils::expr_type(x.m_args[0]); + ASR::ttype_t* right_type = ASRUtils::expr_type(x.m_args[1]); + + ASRUtils::require_impl(ASR::is_a(*left_type) && + ASR::is_a(*right_type), + "Both arguments of SymbolicHasSymbolQ must be of type SymbolicExpression", + x.base.base.loc, diagnostics); + } + + static inline ASR::expr_t* eval_SymbolicHasSymbolQ(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + /*TODO*/ + return nullptr; + } + + static inline ASR::asr_t* create_SymbolicHasSymbolQ(Allocator& al, + const Location& loc, Vec& args, + diag::Diagnostics& diag) { + + if (args.size() != 2) { + append_error(diag, "Intrinsic function SymbolicHasSymbolQ accepts exactly 2 arguments", loc); + return nullptr; + } + + for (size_t i = 0; i < args.size(); i++) { + ASR::ttype_t* argtype = ASRUtils::expr_type(args[i]); + if(!ASR::is_a(*argtype)) { + append_error(diag, "Arguments of SymbolicHasSymbolQ function must be of type SymbolicExpression", + args[i]->base.loc); + return nullptr; + } + } + + Vec arg_values; + arg_values.reserve(al, args.size()); + for( size_t i = 0; i < args.size(); i++ ) { + arg_values.push_back(al, ASRUtils::expr_value(args[i])); + } + + ASR::expr_t* compile_time_value = eval_SymbolicHasSymbolQ(al, loc, logical, arg_values, diag); + return ASR::make_IntrinsicElementalFunction_t(al, loc, + static_cast(IntrinsicElementalFunctions::SymbolicHasSymbolQ), + args.p, args.size(), 0, logical, compile_time_value); + } +} // namespace SymbolicHasSymbolQ + +namespace SymbolicGetArgument { + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, + diag::Diagnostics& diagnostics) { + ASRUtils::require_impl(x.n_args == 2, "Intrinsic function SymbolicGetArgument" + "accepts exactly 2 argument", x.base.base.loc, diagnostics); + + ASR::ttype_t* arg1_type = ASRUtils::expr_type(x.m_args[0]); + ASR::ttype_t* arg2_type = ASRUtils::expr_type(x.m_args[1]); + ASRUtils::require_impl(ASR::is_a(*arg1_type), + "SymbolicGetArgument expects the first argument to be of type SymbolicExpression", + x.base.base.loc, diagnostics); + ASRUtils::require_impl(ASR::is_a(*arg2_type), + "SymbolicGetArgument expects the second argument to be of type Integer", + x.base.base.loc, diagnostics); + } + + static inline ASR::expr_t* eval_SymbolicGetArgument(Allocator &/*al*/, + const Location &/*loc*/, ASR::ttype_t *, Vec &/*args*/, diag::Diagnostics& /*diag*/) { + /*TODO*/ + return nullptr; + } + + static inline ASR::asr_t* create_SymbolicGetArgument(Allocator& al, + const Location& loc, Vec& args, + diag::Diagnostics& diag) { + + if (args.size() != 2) { + append_error(diag, "Intrinsic function SymbolicGetArguments accepts exactly 2 argument", loc); + return nullptr; + } + + ASR::ttype_t* arg1_type = ASRUtils::expr_type(args[0]); + ASR::ttype_t* arg2_type = ASRUtils::expr_type(args[1]); + if (!ASR::is_a(*arg1_type)) { + append_error(diag, "The first argument of SymbolicGetArgument function must be of type SymbolicExpression", + args[0]->base.loc); + return nullptr; + } + if (!ASR::is_a(*arg2_type)) { + append_error(diag, "The second argument of SymbolicGetArgument function must be of type Integer", + args[1]->base.loc); + return nullptr; + } + + ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_SymbolicGetArgument, + static_cast(IntrinsicElementalFunctions::SymbolicGetArgument), + 0, to_type, diag); + } +} // namespace SymbolicGetArgument + +#define create_symbolic_query_macro(X) \ +namespace X { \ + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, \ + diag::Diagnostics& diagnostics) { \ + const Location& loc = x.base.base.loc; \ + ASRUtils::require_impl(x.n_args == 1, \ + #X " must have exactly 1 input argument", loc, diagnostics); \ + \ + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); \ + ASRUtils::require_impl(ASR::is_a(*input_type), \ + #X " expects an argument of type SymbolicExpression", loc, diagnostics); \ + } \ + \ + static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ + ASR::ttype_t *, Vec &/*args*/, diag::Diagnostics& /*diag*/) { \ + /*TODO*/ \ + return nullptr; \ + } \ + \ + static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ + Vec& args, \ + diag::Diagnostics& diag) { \ + if (args.size() != 1) { \ + append_error(diag, "Intrinsic " #X " function accepts exactly 1 argument", \ + loc); \ + return nullptr; \ + } \ + \ + ASR::ttype_t* argtype = ASRUtils::expr_type(args[0]); \ + if (!ASR::is_a(*argtype)) { \ + append_error(diag, \ + "Argument of " #X " function must be of type SymbolicExpression", \ + args[0]->base.loc); \ + return nullptr; \ + } \ + \ + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_##X, \ + static_cast(IntrinsicElementalFunctions::X), 0, logical, diag); \ + } \ +} // namespace X + +create_symbolic_query_macro(SymbolicAddQ) +create_symbolic_query_macro(SymbolicMulQ) +create_symbolic_query_macro(SymbolicPowQ) +create_symbolic_query_macro(SymbolicLogQ) +create_symbolic_query_macro(SymbolicSinQ) + +#define create_symbolic_unary_macro(X) \ +namespace X { \ + static inline void verify_args(const ASR::IntrinsicElementalFunction_t& x, \ + diag::Diagnostics& diagnostics) { \ + const Location& loc = x.base.base.loc; \ + ASRUtils::require_impl(x.n_args == 1, \ + #X " must have exactly 1 input argument", loc, diagnostics); \ + \ + ASR::ttype_t* input_type = ASRUtils::expr_type(x.m_args[0]); \ + ASRUtils::require_impl(ASR::is_a(*input_type), \ + #X " expects an argument of type SymbolicExpression", loc, diagnostics); \ + } \ + \ + static inline ASR::expr_t* eval_##X(Allocator &/*al*/, const Location &/*loc*/, \ + ASR::ttype_t *, Vec &/*args*/, diag::Diagnostics& /*diag*/) { \ + /*TODO*/ \ + return nullptr; \ + } \ + \ + static inline ASR::asr_t* create_##X(Allocator& al, const Location& loc, \ + Vec& args, \ + diag::Diagnostics& diag) { \ + if (args.size() != 1) { \ + append_error(diag, "Intrinsic " #X " function accepts exactly 1 argument", \ + loc); \ + return nullptr; \ + } \ + \ + ASR::ttype_t* argtype = ASRUtils::expr_type(args[0]); \ + if (!ASR::is_a(*argtype)) { \ + append_error(diag, \ + "Argument of " #X " function must be of type SymbolicExpression", \ + args[0]->base.loc); \ + return nullptr; \ + } \ + \ + ASR::ttype_t *to_type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, loc)); \ + return UnaryIntrinsicFunction::create_UnaryFunction(al, loc, args, eval_##X, \ + static_cast(IntrinsicElementalFunctions::X), 0, to_type, diag); \ + } \ +} // namespace X + +create_symbolic_unary_macro(SymbolicSin) +create_symbolic_unary_macro(SymbolicCos) +create_symbolic_unary_macro(SymbolicLog) +create_symbolic_unary_macro(SymbolicExp) +create_symbolic_unary_macro(SymbolicAbs) +create_symbolic_unary_macro(SymbolicExpand) + +} // namespace LCompilers::ASRUtils + +#endif // LIBASR_PASS_INTRINSIC_FUNCTIONS_H diff --git a/src/libasr/pass/intrinsic_subroutine.cpp b/src/libasr/pass/intrinsic_subroutine.cpp new file mode 100644 index 0000000..61e9e9d --- /dev/null +++ b/src/libasr/pass/intrinsic_subroutine.cpp @@ -0,0 +1,185 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include + + +namespace LCompilers { + +/* + +This ASR pass replaces the IntrinsicSubroutine node with a call to an +implementation in ASR that we construct (and cache) on the fly for the actual +arguments. + +Call this pass if you do not want to implement intrinsic subroutines directly +in the backend. + +*/ + +class ReplaceIntrinsicSubroutines : public ASR::CallReplacerOnExpressionsVisitor +{ + private: + + Allocator& al; + SymbolTable* global_scope; + bool remove_original_statement; + Vec pass_result; + Vec* parent_body; + + public: + + ReplaceIntrinsicSubroutines(Allocator& al_) : + al(al_), remove_original_statement(false) { + pass_result.n = 0; + } + + void visit_IntrinsicImpureSubroutine(const ASR::IntrinsicImpureSubroutine_t &x) { + Vec new_args; new_args.reserve(al, x.n_args); + // Replace any IntrinsicImpureSubroutinesin the argument first: + for( size_t i = 0; i < x.n_args; i++ ) { + ASR::call_arg_t arg0; + arg0.loc = x.m_args[i]->base.loc; + arg0.m_value = x.m_args[i]; // Use the converted arg + new_args.push_back(al, arg0); + } + ASRUtils::impl_subroutine instantiate_subroutine = + ASRUtils::IntrinsicImpureSubroutineRegistry::get_instantiate_subroutine(x.m_intrinsic_id); + if( instantiate_subroutine == nullptr ) { + return ; + } + Vec arg_types; + arg_types.reserve(al, x.n_args); + for( size_t i = 0; i < x.n_args; i++ ) { + arg_types.push_back(al, ASRUtils::expr_type(x.m_args[i])); + } + ASR::stmt_t* subroutine_call = instantiate_subroutine(al, x.base.base.loc, + global_scope, arg_types, new_args, x.m_overload_id); + remove_original_statement = true; + pass_result.push_back(al, subroutine_call); + } + + void transform_stmts(ASR::stmt_t **&m_body, size_t &n_body) { + bool remove_original_statement_copy = remove_original_statement; + Vec body; + body.reserve(al, n_body); + if( parent_body ) { + for (size_t j=0; j < pass_result.size(); j++) { + parent_body->push_back(al, pass_result[j]); + } + } + for (size_t i=0; i* parent_body_copy = parent_body; + parent_body = &body; + visit_stmt(*m_body[i]); + parent_body = parent_body_copy; + for (size_t j=0; j < pass_result.size(); j++) { + body.push_back(al, pass_result[j]); + } + if( !remove_original_statement ) { + body.push_back(al, m_body[i]); + } + } + m_body = body.p; + n_body = body.size(); + pass_result.n = 0; + remove_original_statement = remove_original_statement_copy; + } + + // TODO: Only Program and While is processed, we need to process all calls + // to visit_stmt(). + // TODO: Only TranslationUnit's and Program's symbol table is processed + // for transforming function->subroutine if they return arrays + void visit_TranslationUnit(const ASR::TranslationUnit_t &x) { + SymbolTable* current_scope_copy = current_scope; + current_scope = x.m_symtab; + + global_scope = x.m_symtab; + while( global_scope->parent ) { + global_scope = global_scope->parent; + } + + std::vector build_order + = ASRUtils::determine_module_dependencies(x); + for (auto &item : build_order) { + LCOMPILERS_ASSERT(x.m_symtab->get_symbol(item)); + ASR::symbol_t *mod = x.m_symtab->get_symbol(item); + visit_symbol(*mod); + } + + // Now visit everything else + for (auto &item : x.m_symtab->get_scope()) { + if (!ASR::is_a(*item.second)) { + this->visit_symbol(*item.second); + } + } + current_scope = current_scope_copy; + } + + void visit_Module(const ASR::Module_t &x) { + // FIXME: this is a hack, we need to pass in a non-const `x`, + // which requires to generate a TransformVisitor. + SymbolTable* current_scope_copy = current_scope; + current_scope = x.m_symtab; + + global_scope = x.m_symtab; + while( global_scope->parent ) { + global_scope = global_scope->parent; + } + + // Now visit everything else + for (auto &item : x.m_symtab->get_scope()) { + this->visit_symbol(*item.second); + } + current_scope = current_scope_copy; + } + + void visit_Program(const ASR::Program_t &x) { + // FIXME: this is a hack, we need to pass in a non-const `x`, + // which requires to generate a TransformVisitor. + ASR::Program_t& xx = const_cast(x); + SymbolTable* current_scope_copy = current_scope; + current_scope = xx.m_symtab; + global_scope = xx.m_symtab; + + while( global_scope->parent ) { + global_scope = global_scope->parent; + } + + for (auto &item : x.m_symtab->get_scope()) { + if (ASR::is_a(*item.second)) { + ASR::AssociateBlock_t *s = ASR::down_cast(item.second); + visit_AssociateBlock(*s); + } + if (ASR::is_a(*item.second)) { + visit_Function(*ASR::down_cast( + item.second)); + } + } + + transform_stmts(xx.m_body, xx.n_body); + current_scope = current_scope_copy; + } + +}; + +void pass_replace_intrinsic_subroutine(Allocator &al, ASR::TranslationUnit_t &unit, + const LCompilers::PassOptions& /*pass_options*/) { + ReplaceIntrinsicSubroutines v(al); + v.visit_TranslationUnit(unit); + PassUtils::UpdateDependenciesVisitor u(al); + u.visit_TranslationUnit(unit); +} + + +} // namespace LCompilers diff --git a/src/libasr/pass/intrinsic_subroutine_registry.h b/src/libasr/pass/intrinsic_subroutine_registry.h new file mode 100644 index 0000000..d84105d --- /dev/null +++ b/src/libasr/pass/intrinsic_subroutine_registry.h @@ -0,0 +1,88 @@ +#ifndef LFORTRAN_PASS_INTRINSIC_SUBROUTINE_REGISTRY_H +#define LFORTRAN_PASS_INTRINSIC_SUBROUTINE_REGISTRY_H + +// #include +#include + +#include +#include +#include + +namespace LCompilers { + +namespace ASRUtils { + +#define INTRINSIC_SUBROUTINE_NAME_CASE(X) \ + case (static_cast(ASRUtils::IntrinsicImpureSubroutines::X)) : { \ + return #X; \ + } + +inline std::string get_intrinsic_subroutine_name(int x) { + switch (x) { + INTRINSIC_SUBROUTINE_NAME_CASE(RandomNumber) + default : { + throw LCompilersException("pickle: intrinsic_id not implemented"); + } + } +} + +/************************* Intrinsic Impure Subroutine **************************/ + +namespace IntrinsicImpureSubroutineRegistry { + + static const std::map>& intrinsic_subroutine_by_id_db = { + {static_cast(IntrinsicImpureSubroutines::RandomNumber), + {&RandomNumber::instantiate_RandomNumber, &RandomNumber::verify_args}}, + }; + + static const std::map& intrinsic_subroutine_id_to_name = { + {static_cast(IntrinsicImpureSubroutines::RandomNumber), + "random_number"}, + }; + + + static const std::map& intrinsic_subroutine_by_name_db = { + {"random_number", &RandomNumber::create_RandomNumber}, + }; + + static inline bool is_intrinsic_subroutine(const std::string& name) { + return intrinsic_subroutine_by_name_db.find(name) != intrinsic_subroutine_by_name_db.end(); + } + + static inline bool is_intrinsic_subroutine(int64_t id) { + return intrinsic_subroutine_by_id_db.find(id) != intrinsic_subroutine_by_id_db.end(); + } + + static inline create_intrinsic_subroutine get_create_subroutine(const std::string& name) { + return intrinsic_subroutine_by_name_db.at(name); + } + + static inline verify_subroutine get_verify_subroutine(int64_t id) { + return std::get<1>(intrinsic_subroutine_by_id_db.at(id)); + } + + static inline impl_subroutine get_instantiate_subroutine(int64_t id) { + if( intrinsic_subroutine_by_id_db.find(id) == intrinsic_subroutine_by_id_db.end() ) { + return nullptr; + } + return std::get<0>(intrinsic_subroutine_by_id_db.at(id)); + } + + static inline std::string get_intrinsic_subroutine_name(int64_t id) { + if( intrinsic_subroutine_id_to_name.find(id) == intrinsic_subroutine_id_to_name.end() ) { + throw LCompilersException("IntrinsicSubroutine with ID " + std::to_string(id) + + " has no name registered for it"); + } + return intrinsic_subroutine_id_to_name.at(id); + } + +} // namespace IntrinsicImpureSubroutineRegistry + +} // namespace ASRUtils + +} // namespace LCompilers + +#endif // LFORTRAN_PASS_INTRINSIC_SUBROUTINE_REGISTRY_H diff --git a/src/libasr/pass/intrinsic_subroutines.h b/src/libasr/pass/intrinsic_subroutines.h new file mode 100644 index 0000000..f4b946b --- /dev/null +++ b/src/libasr/pass/intrinsic_subroutines.h @@ -0,0 +1,120 @@ +#ifndef LIBASR_PASS_INTRINSIC_SUBROUTINES_H +#define LIBASR_PASS_INTRINSIC_SUBROUTINES_H + + +#include +#include + +namespace LCompilers::ASRUtils { + +/* +To add a new subroutine implementation, + +1. Create a new namespace like, `Sin`, `LogGamma` in this file. +2. In the above created namespace add `eval_*`, `instantiate_*`, and `create_*`. +3. Then register in the maps present in `IntrinsicImpureSubroutineRegistry`. + +You can use helper macros and define your own helper macros to reduce +the code size. +*/ + +enum class IntrinsicImpureSubroutines : int64_t { + RandomNumber, + // ... +}; + +typedef ASR::stmt_t* (*impl_subroutine)( + Allocator&, const Location &, + SymbolTable*, Vec&, + Vec&, int64_t); + +typedef ASR::asr_t* (*create_intrinsic_subroutine)( + Allocator&, const Location&, + Vec&, + diag::Diagnostics&); + +typedef void (*verify_subroutine)( + const ASR::IntrinsicImpureSubroutine_t&, + diag::Diagnostics&); + +typedef ASR::expr_t* (*get_initial_value_sub)(Allocator&, ASR::ttype_t*); + +namespace RandomNumber { + + static inline void verify_args(const ASR::IntrinsicImpureSubroutine_t& x, diag::Diagnostics& diagnostics) { + if (x.n_args == 1) { + ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for random_number expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics); + } + else { + ASRUtils::require_impl(false, "Unexpected number of args, random_number takes 1 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics); + } + } + + static inline ASR::asr_t* create_RandomNumber(Allocator& al, const Location& loc, Vec& args, diag::Diagnostics& /*diag*/) { + Vec m_args; m_args.reserve(al, 1); m_args.push_back(al, args[0]); + return ASR::make_IntrinsicImpureSubroutine_t(al, loc, static_cast(IntrinsicImpureSubroutines::RandomNumber), m_args.p, m_args.n, 0); + } + + static inline ASR::stmt_t* instantiate_RandomNumber(Allocator &al, const Location &loc, + SymbolTable *scope, Vec& arg_types, + Vec& new_args, int64_t /*overload_id*/) { + std::string c_func_name; + int kind = ASRUtils::extract_kind_from_ttype_t(arg_types[0]); + if ( kind == 4 ) { + c_func_name = "_lfortran_sp_rand_num"; + } else { + c_func_name = "_lfortran_dp_rand_num"; + } + std::string new_name = "_lcompilers_random_number_"; + + declare_basic_variables(new_name); + fill_func_arg_sub("r", arg_types[0], InOut); + SymbolTable *fn_symtab_1 = al.make_new(fn_symtab); + Vec args_1; args_1.reserve(al, 0); + ASR::expr_t *return_var_1 = b.Variable(fn_symtab_1, c_func_name, + ASRUtils::type_get_past_array(ASRUtils::type_get_past_allocatable(arg_types[0])), + ASRUtils::intent_return_var, ASR::abiType::BindC, false); + SetChar dep_1; dep_1.reserve(al, 1); + Vec body_1; body_1.reserve(al, 1); + ASR::symbol_t *s = make_ASR_Function_t(c_func_name, fn_symtab_1, dep_1, args_1, + body_1, return_var_1, ASR::abiType::BindC, ASR::deftypeType::Interface, s2c(al, c_func_name)); + fn_symtab->add_symbol(c_func_name, s); + dep.push_back(al, s2c(al, c_func_name)); + + if (ASRUtils::is_array(ASRUtils::expr_type(args[0]))) { + /* + real :: b(3) + call random_number(b) + To + real :: b(3) + do i=lbound(b,1),ubound(b,1) + call random_number(b(i)) + end do + */ + ASR::dimension_t* array_dims = nullptr; + int array_rank = extract_dimensions_from_ttype(arg_types[0], array_dims); + std::vector do_loop_variables; + for (int i = 0; i < array_rank; i++) { + do_loop_variables.push_back(declare("i_" + std::to_string(i), int32, Local)); + } + ASR::stmt_t* func_call = b.CallIntrinsicSubroutine(scope, {ASRUtils::type_get_past_array(ASRUtils::type_get_past_allocatable(arg_types[0]))}, + {b.ArrayItem_01(args[0], do_loop_variables)}, 0, RandomNumber::instantiate_RandomNumber); + fn_name = scope->get_unique_name(fn_name, false); + body.push_back(al, PassUtils::create_do_loop_helper_random_number(al, loc, do_loop_variables, s, args[0], + ASRUtils::type_get_past_array(ASRUtils::type_get_past_allocatable(arg_types[0])), + b.ArrayItem_01(args[0], do_loop_variables), func_call, 1)); + } else { + Vec call_args; call_args.reserve(al, 0); + body.push_back(al, b.Assignment(args[0], b.Call(s, call_args, arg_types[0]))); + } + ASR::symbol_t *new_symbol = make_ASR_Function_t(fn_name, fn_symtab, dep, args, + body, nullptr, ASR::abiType::Source, ASR::deftypeType::Implementation, nullptr); + scope->add_symbol(fn_name, new_symbol); + return b.SubroutineCall(new_symbol, new_args); + } + +} // namespace RandomNumber + +} // namespace LCompilers::ASRUtils + +#endif // LIBASR_PASS_INTRINSIC_SUBROUTINES_H diff --git a/src/libasr/pass/loop_unroll.cpp b/src/libasr/pass/loop_unroll.cpp index 58523e4..7a9135a 100644 --- a/src/libasr/pass/loop_unroll.cpp +++ b/src/libasr/pass/loop_unroll.cpp @@ -90,7 +90,7 @@ class LoopUnrollVisitor : public PassUtils::PassVisitor pass_result.push_back(al, init_stmt); ASR::stmt_t* unrolled_whileloop = ASRUtils::STMT(ASR::make_WhileLoop_t(al, x.base.base.loc, - whileloop->m_name, whileloop->m_test, unrolled_loop.p, unrolled_loop.size())); + whileloop->m_name, whileloop->m_test, unrolled_loop.p, unrolled_loop.size(), x.m_orelse, x.n_orelse)); pass_result.push_back(al, unrolled_whileloop); for( int64_t i = 0; i < remaining_part; i++ ) { for( size_t i = 0; i < whileloop->n_body; i++ ) { diff --git a/src/libasr/pass/loop_vectorise.cpp b/src/libasr/pass/loop_vectorise.cpp index 25bde65..ab7cd06 100644 --- a/src/libasr/pass/loop_vectorise.cpp +++ b/src/libasr/pass/loop_vectorise.cpp @@ -175,7 +175,7 @@ class LoopVectoriseVisitor : public PassUtils::SkipOptimizationFunctionVisitor(x); ASRUtils::Call_t_body(al, xx.m_name, xx.m_args, xx.n_args, x.m_dt, - nullptr, false); + nullptr, false, false); } void visit_SubroutineCall(const ASR::SubroutineCall_t &x) { @@ -441,7 +441,7 @@ class ReplaceNestedVisitor: public ASR::CallReplacerOnExpressionsVisitor(x); ASRUtils::Call_t_body(al, xx.m_name, xx.m_args, xx.n_args, x.m_dt, - nullptr, false); + nullptr, false, ASRUtils::get_class_proc_nopass_val(x.m_name)); } void visit_Array(const ASR::Array_t& /*x*/) { @@ -506,13 +506,13 @@ class AssignNestedVars: public PassUtils::PassVisitor { std::string sym_name = ASRUtils::symbol_name(sym_); sym_ = current_scope->get_symbol(sym_name); if( !sym_ ) { + ASR::symbol_t *s = ASRUtils::symbol_get_past_external(sym); ASR::asr_t *fn = ASR::make_ExternalSymbol_t( al, t->base.loc, /* a_symtab */ current_scope, /* a_name */ s2c(al, current_scope->get_unique_name(sym_name, false)), - ASRUtils::symbol_get_past_external(sym), - ASRUtils::symbol_name(ASRUtils::get_asr_owner(ASRUtils::symbol_get_past_external(sym))), - nullptr, 0, s2c(al, sym_name), ASR::accessType::Public + s, ASRUtils::symbol_name(ASRUtils::get_asr_owner(s)), + nullptr, 0, ASRUtils::symbol_name(s), ASR::accessType::Public ); sym_ = ASR::down_cast(fn); current_scope->add_symbol(sym_name, sym_); diff --git a/src/libasr/pass/pass_array_by_data.cpp b/src/libasr/pass/pass_array_by_data.cpp index 148fc2c..453acdc 100644 --- a/src/libasr/pass/pass_array_by_data.cpp +++ b/src/libasr/pass/pass_array_by_data.cpp @@ -380,6 +380,12 @@ class EditProcedureVisitor: public ASR::CallReplacerOnExpressionsVisitor::visit_BlockCall(x); } + void visit_AssociateBlockCall(const ASR::AssociateBlockCall_t& x) { + ASR::AssociateBlockCall_t& xx = const_cast(x); + edit_symbol_reference(m) + ASR::CallReplacerOnExpressionsVisitor::visit_AssociateBlockCall(x); + } + void visit_SubroutineCall(const ASR::SubroutineCall_t& x) { ASR::SubroutineCall_t& xx = const_cast(x); edit_symbol_reference(name) @@ -451,6 +457,25 @@ class EditProcedureCallsVisitor : public ASR::ASRPassBaseWalkVisitor& dims, + Allocator& al) { + ASR::ttype_t* array_type = ASRUtils::expr_type(array); + ASR::dimension_t* compile_time_dims = nullptr; + int n_dims = ASRUtils::extract_dimensions_from_ttype(array_type, compile_time_dims); + for( int i = 0; i < n_dims; i++ ) { + ASR::expr_t* start = compile_time_dims[i].m_start; + if( start == nullptr ) { + start = PassUtils::get_bound(array, i + 1, "lbound", al); + } + ASR::expr_t* length = compile_time_dims[i].m_length; + if( length == nullptr ) { + length = ASRUtils::get_size(array, i + 1, al); + } + dims.push_back(al, start); + dims.push_back(al, length); + } + } + Vec construct_new_args(size_t n_args, ASR::call_arg_t* orig_args, std::vector& indices) { Vec new_args; new_args.reserve(al, n_args); @@ -484,7 +509,7 @@ class EditProcedureCallsVisitor : public ASR::ASRPassBaseWalkVisitor dim_vars; dim_vars.reserve(al, 2); - ASRUtils::get_dimensions(orig_arg_i, dim_vars, al); + get_dimensions(orig_arg_i, dim_vars, al); for( size_t j = 0; j < dim_vars.size(); j++ ) { ASR::call_arg_t dim_var; dim_var.loc = dim_vars[j]->base.loc; @@ -544,12 +569,10 @@ class EditProcedureCallsVisitor : public ASR::ASRPassBaseWalkVisitor #include #include +#include namespace LCompilers { @@ -71,6 +72,15 @@ namespace LCompilers { ASR::ttype_t* x_type = ASR::down_cast(x)->m_type; ASR::dimension_t* m_dims; get_dim_rank(x_type, m_dims, n_dims); + } else if (ASR::is_a(*x)) { + ASR::ComplexConstructor_t* cc = ASR::down_cast(x); + return get_rank(cc->m_re); + } else if (ASR::is_a(*x)) { + ASR::ComplexIm_t* cc = ASR::down_cast(x); + return get_rank(cc->m_arg); + } else if (ASR::is_a(*x)) { + ASR::ComplexRe_t* cc = ASR::down_cast(x); + return get_rank(cc->m_arg); } return n_dims; } @@ -126,6 +136,9 @@ namespace LCompilers { ASR::expr_t* create_array_ref(ASR::expr_t* arr_expr, Vec& idx_vars, Allocator& al, SymbolTable* current_scope, bool perform_cast, ASR::cast_kindType cast_kind, ASR::ttype_t* casted_type) { + if (idx_vars.size() == 0) { + return arr_expr; + } Vec args; args.reserve(al, 1); for( size_t i = 0; i < idx_vars.size(); i++ ) { @@ -493,6 +506,101 @@ namespace LCompilers { return v; } + ASR::stmt_t* create_do_loop_helper_count(Allocator &al, const Location &loc, std::vector do_loop_variables, ASR::expr_t* mask, ASR::expr_t* res, int curr_idx) { + ASRUtils::ASRBuilder b(al, loc); + + if (curr_idx == 1) { + std::vector vars; + for (size_t i = 0; i < do_loop_variables.size(); i++) { + vars.push_back(do_loop_variables[i]); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(mask, curr_idx), UBound(mask, curr_idx), { + b.If(b.ArrayItem_01(mask, vars), { + b.Assignment(res, b.Add(res, b.i(1, ASRUtils::expr_type(res)))) + }, {}), + }, nullptr); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(mask, curr_idx), UBound(mask, curr_idx), { + create_do_loop_helper_count(al, loc, do_loop_variables, mask, res, curr_idx - 1) + }, nullptr); + } + + ASR::stmt_t* create_do_loop_helper_count_dim(Allocator &al, const Location &loc, std::vector do_loop_variables, + std::vector res_idx, ASR::stmt_t* inner_most_do_loop, + ASR::expr_t* c, ASR::expr_t* mask, ASR::expr_t* res, int curr_idx, int dim) { + ASRUtils::ASRBuilder b(al, loc); + + if (curr_idx == (int) do_loop_variables.size() - 1) { + return b.DoLoop(do_loop_variables[curr_idx], LBound(mask, curr_idx + 1), UBound(mask, curr_idx + 1), { + b.Assignment(c, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 0, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))))), + inner_most_do_loop, + b.Assignment(b.ArrayItem_01(res, {res_idx}), c) + }); + } + if (curr_idx != dim - 1) { + return b.DoLoop(do_loop_variables[curr_idx], LBound(mask, curr_idx + 1), UBound(mask, curr_idx + 1), { + create_do_loop_helper_count_dim(al, loc, do_loop_variables, res_idx, inner_most_do_loop, c, mask, res, curr_idx + 1, dim) + }); + } else { + return create_do_loop_helper_count_dim(al, loc, do_loop_variables, res_idx, inner_most_do_loop, c, mask, res, curr_idx + 1, dim); + } + } + + ASR::stmt_t* create_do_loop_helper_pack(Allocator &al, const Location &loc, std::vector do_loop_variables, ASR::expr_t* array, ASR::expr_t* mask, ASR::expr_t* res, ASR::expr_t* idx, int curr_idx) { + ASRUtils::ASRBuilder b(al, loc); + + if (curr_idx == 1) { + std::vector vars; + for (size_t i = 0; i < do_loop_variables.size(); i++) { + vars.push_back(do_loop_variables[i]); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(array, curr_idx), UBound(array, curr_idx), { + b.If(b.ArrayItem_01(mask, vars), { + b.Assignment(b.ArrayItem_01(res, {idx}), b.ArrayItem_01(array, vars)), + b.Assignment(idx, b.Add(idx, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 1, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))))) + }, {}), + }, nullptr); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(array, curr_idx), UBound(array, curr_idx), { + create_do_loop_helper_pack(al, loc, do_loop_variables, array, mask, res, idx, curr_idx - 1) + }, nullptr); + } + + ASR::stmt_t* create_do_loop_helper_unpack(Allocator &al, const Location &loc, std::vector do_loop_variables, ASR::expr_t* vector, ASR::expr_t* mask, ASR::expr_t* res, ASR::expr_t* idx, int curr_idx) { + ASRUtils::ASRBuilder b(al, loc); + if (curr_idx == 1) { + std::vector vars; + for (size_t i = 0; i < do_loop_variables.size(); i++) { + vars.push_back(do_loop_variables[i]); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(mask, 1), UBound(mask, 1), { + b.If(b.ArrayItem_01(mask, vars), { + b.Assignment(b.ArrayItem_01(res, vars), b.ArrayItem_01(vector, {idx})), + b.Assignment(idx, b.Add(idx, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 1, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))))) + }, {}), + }, nullptr); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(mask, curr_idx), UBound(mask, curr_idx), { + create_do_loop_helper_unpack(al, loc, do_loop_variables, vector, mask, res, idx, curr_idx - 1) + }, nullptr); + } + + ASR::stmt_t* create_do_loop_helper_random_number(Allocator &al, const Location &loc, std::vector do_loop_variables, + ASR::symbol_t* s, ASR::expr_t* arr, ASR::ttype_t* return_type, ASR::expr_t* arr_item, ASR::stmt_t* stmt, int curr_idx) { + ASRUtils::ASRBuilder b(al, loc); + if (curr_idx == (int)do_loop_variables.size()) { + // ASR::expr_t* arr_item = b.ArrayItem_01(arr, do_loop_variables); + Vec args; args.reserve(al, 1); args.push_back(al, arr_item); + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(arr, curr_idx), UBound(arr, curr_idx), { + stmt + }, nullptr); + } + return b.DoLoop(do_loop_variables[curr_idx - 1], LBound(arr, curr_idx), UBound(arr, curr_idx), { + create_do_loop_helper_random_number(al, loc, do_loop_variables, s, arr, return_type, arr_item, stmt, curr_idx + 1) + }, nullptr); + + } + // Imports the function from an already loaded ASR module ASR::symbol_t* import_function2(std::string func_name, std::string module_name, Allocator& al, ASR::TranslationUnit_t& unit, @@ -568,8 +676,7 @@ namespace LCompilers { } } - ASR::expr_t* get_bound(ASR::expr_t* arr_expr, int dim, std::string bound, - Allocator& al) { + ASR::expr_t* get_bound(ASR::expr_t* arr_expr, int dim, std::string bound, Allocator& al) { ASR::ttype_t* x_mv_type = ASRUtils::expr_type(arr_expr); ASR::dimension_t* m_dims; int n_dims = ASRUtils::extract_dimensions_from_ttype(x_mv_type, m_dims); @@ -581,8 +688,12 @@ namespace LCompilers { ASR::expr_t* zero = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 0, int32_type)); ASR::expr_t* one = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 1, int32_type)); if( bound == "ubound" ) { - return ASRUtils::EXPR(ASR::make_IntegerBinOp_t( - al, arr_expr->base.loc, m_dims[dim - 1].m_length, ASR::binopType::Sub, one, int32_type, nullptr)); + return ASRUtils::EXPR( + ASR::make_IntegerBinOp_t(al, arr_expr->base.loc, + ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, arr_expr->base.loc, + m_dims[dim - 1].m_length, ASR::binopType::Sub, one, int32_type, nullptr)), + ASR::binopType::Add, m_dims[dim - 1].m_start, int32_type, nullptr) + ); } if ( m_dims[dim - 1].m_start != nullptr ) { return m_dims[dim - 1].m_start; @@ -613,18 +724,18 @@ namespace LCompilers { Allocator& al, ASR::TranslationUnit_t& unit, const Location& loc, PassOptions& pass_options) { ASR::ttype_t* type = ASRUtils::expr_type(arg1); - int64_t fp_s = static_cast(ASRUtils::IntrinsicScalarFunctions::FlipSign); + int64_t fp_s = static_cast(ASRUtils::IntrinsicElementalFunctions::FlipSign); if (skip_instantiation(pass_options, fp_s)) { Vec args; args.reserve(al, 2); args.push_back(al, arg0); args.push_back(al, arg1); - return ASRUtils::EXPR(ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, fp_s, + return ASRUtils::EXPR(ASRUtils::make_IntrinsicElementalFunction_t_util(al, loc, fp_s, args.p, args.n, 0, type, nullptr)); } ASRUtils::impl_function instantiate_function = - ASRUtils::IntrinsicScalarFunctionRegistry::get_instantiate_function( - static_cast(ASRUtils::IntrinsicScalarFunctions::FlipSign)); + ASRUtils::IntrinsicElementalFunctionRegistry::get_instantiate_function( + static_cast(ASRUtils::IntrinsicElementalFunctions::FlipSign)); Vec arg_types; arg_types.reserve(al, 2); arg_types.push_back(al, ASRUtils::expr_type(arg0)); @@ -669,8 +780,8 @@ namespace LCompilers { Allocator& al, SymbolTable*& current_scope, ASR::stmt_t*& assign_stmt) { ASR::asr_t* expr_sym = ASR::make_Variable_t(al, expr->base.loc, current_scope, s2c(al, name), nullptr, 0, ASR::intentType::Local, nullptr, nullptr, ASR::storage_typeType::Default, - ASRUtils::duplicate_type(al, ASRUtils::expr_type(expr)), nullptr, ASR::abiType::Source, ASR::accessType::Public, - ASR::presenceType::Required, false); + ASRUtils::duplicate_type(al, ASRUtils::extract_type(ASRUtils::expr_type(expr))), + nullptr, ASR::abiType::Source, ASR::accessType::Public, ASR::presenceType::Required, false); if( current_scope->get_symbol(name) == nullptr ) { current_scope->add_symbol(name, ASR::down_cast(expr_sym)); } else { @@ -701,20 +812,20 @@ namespace LCompilers { ASR::expr_t* get_fma(ASR::expr_t* arg0, ASR::expr_t* arg1, ASR::expr_t* arg2, Allocator& al, ASR::TranslationUnit_t& unit, Location& loc, PassOptions& pass_options) { - int64_t fma_id = static_cast(ASRUtils::IntrinsicScalarFunctions::FMA); + int64_t fma_id = static_cast(ASRUtils::IntrinsicElementalFunctions::FMA); ASR::ttype_t* type = ASRUtils::expr_type(arg0); - if (skip_instantiation(pass_options, fma_id)) { + if (skip_instantiation(pass_options, fma_id) || ASRUtils::is_simd_array(arg0)) { Vec args; args.reserve(al, 3); args.push_back(al, arg0); args.push_back(al, arg1); args.push_back(al, arg2); - return ASRUtils::EXPR(ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, fma_id, + return ASRUtils::EXPR(ASRUtils::make_IntrinsicElementalFunction_t_util(al, loc, fma_id, args.p, args.n, 0, type, nullptr)); } ASRUtils::impl_function instantiate_function = - ASRUtils::IntrinsicScalarFunctionRegistry::get_instantiate_function( - static_cast(ASRUtils::IntrinsicScalarFunctions::FMA)); + ASRUtils::IntrinsicElementalFunctionRegistry::get_instantiate_function( + static_cast(ASRUtils::IntrinsicElementalFunctions::FMA)); Vec arg_types; arg_types.reserve(al, 3); arg_types.push_back(al, ASRUtils::expr_type(arg0)); @@ -778,7 +889,7 @@ namespace LCompilers { target, value, nullptr)); loop_body.push_back(al, copy_stmt); ASR::stmt_t* fallback_loop = ASRUtils::STMT(ASR::make_DoLoop_t(al, do_loop_head.loc, - nullptr, do_loop_head, loop_body.p, loop_body.size())); + nullptr, do_loop_head, loop_body.p, loop_body.size(), nullptr, 0)); Vec fallback_while_loop = replace_doloop(al, *ASR::down_cast(fallback_loop), (int) ASR::cmpopType::Lt); for( size_t i = 0; i < fallback_while_loop.size(); i++ ) { @@ -827,25 +938,25 @@ namespace LCompilers { args.push_back(al, arg5_); return ASRUtils::STMT(ASRUtils::make_SubroutineCall_t_util(al, loc, v, nullptr, args.p, args.size(), - nullptr, nullptr, false)); + nullptr, nullptr, false, false)); } ASR::expr_t* get_sign_from_value(ASR::expr_t* arg0, ASR::expr_t* arg1, Allocator& al, ASR::TranslationUnit_t& unit, Location& loc, PassOptions& pass_options) { - int64_t sfv_id = static_cast(ASRUtils::IntrinsicScalarFunctions::SignFromValue); + int64_t sfv_id = static_cast(ASRUtils::IntrinsicElementalFunctions::SignFromValue); ASR::ttype_t* type = ASRUtils::expr_type(arg0); if (skip_instantiation(pass_options, sfv_id)) { Vec args; args.reserve(al, 2); args.push_back(al, arg0); args.push_back(al, arg1); - return ASRUtils::EXPR(ASRUtils::make_IntrinsicScalarFunction_t_util(al, loc, sfv_id, + return ASRUtils::EXPR(ASRUtils::make_IntrinsicElementalFunction_t_util(al, loc, sfv_id, args.p, args.n, 0, type, nullptr)); } ASRUtils::impl_function instantiate_function = - ASRUtils::IntrinsicScalarFunctionRegistry::get_instantiate_function( - static_cast(ASRUtils::IntrinsicScalarFunctions::FMA)); + ASRUtils::IntrinsicElementalFunctionRegistry::get_instantiate_function( + static_cast(ASRUtils::IntrinsicElementalFunctions::FMA)); Vec arg_types; arg_types.reserve(al, 2); arg_types.push_back(al, ASRUtils::expr_type(arg0)); @@ -862,6 +973,24 @@ namespace LCompilers { unit.m_symtab, arg_types, type, args, 0); } + void cast_util(ASR::expr_t*& left, ASR::expr_t*& right, Allocator& al, bool is_assign=false) { + ASR::ttype_t *src_type = nullptr, *dest_type = nullptr; + ASR::expr_t *src_expr = nullptr, *dest_expr = nullptr; + int casted_expression_signal = LCompilers::CastingUtil::get_src_dest( + left, right, src_expr, dest_expr, src_type, dest_type, is_assign); + if( casted_expression_signal != 2 ) { + src_expr = CastingUtil::perform_casting( + src_expr, dest_type, al, src_expr->base.loc); + if( casted_expression_signal == 0 ) { + left = src_expr; + right = dest_expr; + } else if( casted_expression_signal == 1 ) { + left = dest_expr; + right = src_expr; + } + } + } + Vec replace_doloop(Allocator &al, const ASR::DoLoop_t &loop, int comp, bool use_loop_variable_after_loop) { Location loc = loop.base.base.loc; @@ -872,6 +1001,14 @@ namespace LCompilers { ASR::stmt_t *inc_stmt = nullptr; ASR::stmt_t *loop_init_stmt = nullptr; ASR::stmt_t *stmt_add_c_after_loop = nullptr; + if( loop.m_head.m_v ) { + ASR::expr_t* loop_head = loop.m_head.m_v; + cast_util(loop_head, a, al, true); + cast_util(loop_head, b, al, true); + if( c ) { + cast_util(loop_head, c, al, true); + } + } if( !a && !b && !c ) { int a_kind = 4; if( loop.m_head.m_v ) { @@ -976,9 +1113,11 @@ namespace LCompilers { ASR::binopType::Add, c, type, nullptr)), nullptr)); if (cond == nullptr) { ASR::ttype_t *log_type = ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)); + ASR::expr_t* left = ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, loc, target, + ASR::binopType::Add, c, type, nullptr)); + cond = ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, - ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, loc, target, - ASR::binopType::Add, c, type, nullptr)), cmp_op, b, log_type, nullptr)); + left, cmp_op, b, log_type, nullptr)); } } Vec body; @@ -990,7 +1129,7 @@ namespace LCompilers { body.push_back(al, loop.m_body[i]); } ASR::stmt_t *while_loop_stmt = ASRUtils::STMT(ASR::make_WhileLoop_t(al, loc, - loop.m_name, cond, body.p, body.size())); + loop.m_name, cond, body.p, body.size(), loop.m_orelse, loop.n_orelse)); Vec result; result.reserve(al, 2); if( loop_init_stmt ) { @@ -1004,28 +1143,58 @@ namespace LCompilers { return result; } + #define increment_by_one(var, body) ASR::expr_t* inc_by_one = builder.ElementalAdd(var, \ + make_ConstantWithType(make_IntegerConstant_t, 1, \ + ASRUtils::expr_type(var), loc), loc); \ + ASR::stmt_t* assign_inc = builder.Assignment(var, inc_by_one); \ + body->push_back(al, assign_inc); \ + namespace ReplacerUtils { void visit_ArrayConstant(ASR::ArrayConstant_t* x, Allocator& al, ASR::expr_t* arr_var, Vec* result_vec, ASR::expr_t* idx_var, SymbolTable* current_scope, bool perform_cast, ASR::cast_kindType cast_kind, ASR::ttype_t* casted_type) { - #define increment_by_one(var, body) ASR::expr_t* inc_by_one = builder.ElementalAdd(var, \ - make_ConstantWithType(make_IntegerConstant_t, 1, \ - ASRUtils::expr_type(var), loc), loc); \ - ASR::stmt_t* assign_inc = builder.Assignment(var, inc_by_one); \ - body->push_back(al, assign_inc); \ + const Location& loc = arr_var->base.loc; + ASRUtils::ASRBuilder builder(al, loc); + for( size_t k = 0; k < x->n_args; k++ ) { + ASR::expr_t* curr_init = x->m_args[k]; + ASR::expr_t* res = PassUtils::create_array_ref(arr_var, idx_var, + al, current_scope); + if( perform_cast && !ASRUtils::types_equal(ASRUtils::expr_type(curr_init), casted_type) ) { + curr_init = ASRUtils::EXPR(ASR::make_Cast_t( + al, curr_init->base.loc, curr_init, cast_kind, casted_type, nullptr)); + } + ASR::stmt_t* assign = builder.Assignment(res, curr_init); + result_vec->push_back(al, assign); + increment_by_one(idx_var, result_vec) + } + } + void visit_ArrayConstructor(ASR::ArrayConstructor_t* x, Allocator& al, + ASR::expr_t* arr_var, Vec* result_vec, + ASR::expr_t* idx_var, SymbolTable* current_scope, + bool perform_cast, ASR::cast_kindType cast_kind, ASR::ttype_t* casted_type) { const Location& loc = arr_var->base.loc; ASRUtils::ASRBuilder builder(al, loc); for( size_t k = 0; k < x->n_args; k++ ) { ASR::expr_t* curr_init = x->m_args[k]; + if( ASR::is_a(*curr_init) ) { + perform_cast = true; + cast_kind = ASR::down_cast(curr_init)->m_kind; + casted_type = ASR::down_cast(curr_init)->m_type; + curr_init = ASR::down_cast(curr_init)->m_arg; + } if( ASR::is_a(*curr_init) ) { ASR::ImpliedDoLoop_t* idoloop = ASR::down_cast(curr_init); - create_do_loop(al, idoloop, arr_var, result_vec, idx_var, perform_cast, cast_kind); + create_do_loop(al, idoloop, arr_var, result_vec, idx_var, perform_cast, cast_kind, casted_type); } else if( ASR::is_a(*curr_init) ) { ASR::ArrayConstant_t* array_constant_t = ASR::down_cast(curr_init); visit_ArrayConstant(array_constant_t, al, arr_var, result_vec, - idx_var, current_scope, perform_cast, cast_kind); + idx_var, current_scope, perform_cast, cast_kind, casted_type); + } else if( ASR::is_a(*curr_init) ) { + ASR::ArrayConstructor_t* array_constructor_t = ASR::down_cast(curr_init); + visit_ArrayConstructor(array_constructor_t, al, arr_var, result_vec, + idx_var, current_scope, perform_cast, cast_kind, casted_type); } else if( ASR::is_a(*curr_init) ) { ASR::ttype_t* element_type = ASRUtils::expr_type(curr_init); if( ASRUtils::is_array(element_type) ) { @@ -1043,7 +1212,7 @@ namespace LCompilers { }, current_scope, result_vec); } else { ASR::expr_t* res = PassUtils::create_array_ref(arr_var, idx_var, al, current_scope); - if( perform_cast ) { + if( perform_cast && !ASRUtils::types_equal(ASRUtils::expr_type(curr_init), casted_type) ) { curr_init = ASRUtils::EXPR(ASR::make_Cast_t( al, curr_init->base.loc, curr_init, cast_kind, casted_type, nullptr)); } diff --git a/src/libasr/pass/pass_utils.h b/src/libasr/pass/pass_utils.h index e8d5196..e92191c 100644 --- a/src/libasr/pass/pass_utils.h +++ b/src/libasr/pass/pass_utils.h @@ -110,13 +110,112 @@ namespace LCompilers { Vec replace_doloop(Allocator &al, const ASR::DoLoop_t &loop, int comp=-1, bool use_loop_variable_after_loop=false); + ASR::stmt_t* create_do_loop_helper_pack(Allocator &al, const Location &loc, + std::vector do_loop_variables, ASR::expr_t* array, ASR::expr_t* mask, + ASR::expr_t* res, ASR::expr_t* idx, int curr_idx); + + ASR::stmt_t* create_do_loop_helper_unpack(Allocator &al, const Location &loc, + std::vector do_loop_variables, ASR::expr_t* vector, ASR::expr_t* mask, + ASR::expr_t* res, ASR::expr_t* idx, int curr_idx); + + ASR::stmt_t* create_do_loop_helper_count(Allocator &al, const Location &loc, + std::vector do_loop_variables, ASR::expr_t* mask, ASR::expr_t* res, + int curr_idx); + + ASR::stmt_t* create_do_loop_helper_count_dim(Allocator &al, const Location &loc, + std::vector do_loop_variables, std::vector res_idx, + ASR::stmt_t* inner_most_do_loop, ASR::expr_t* c, ASR::expr_t* mask, ASR::expr_t* res, + int curr_idx, int dim); + + ASR::stmt_t* create_do_loop_helper_random_number(Allocator &al, const Location &loc, + std::vector do_loop_variables, ASR::symbol_t* s, ASR::expr_t* arr, + ASR::ttype_t* return_type, ASR::expr_t* arr_item, ASR::stmt_t* stmt, int curr_idx); + static inline bool is_aggregate_type(ASR::expr_t* var) { return ASR::is_a(*ASRUtils::expr_type(var)); } static inline bool is_aggregate_or_array_type(ASR::expr_t* var) { return (ASR::is_a(*ASRUtils::expr_type(var)) || - ASRUtils::is_array(ASRUtils::expr_type(var))); + ASRUtils::is_array(ASRUtils::expr_type(var)) || + ASR::is_a(*ASRUtils::expr_type(var))); + } + + static inline bool is_symbolic_list_type(ASR::expr_t* var) { + if (ASR::is_a(*ASRUtils::expr_type(var))) { + ASR::List_t *list = ASR::down_cast(ASRUtils::expr_type(var)); + return (list->m_type->type == ASR::ttypeType::SymbolicExpression); + } + return false; + } + + static inline void allocate_res_var(Allocator& al, ASR::FunctionCall_t* x, Vec &new_args, + ASR::expr_t* result_var_, Vec& pass_result, std::vector map) { + ASR::expr_t* func_call_merge = nullptr; + ASR::Function_t* sum = ASR::down_cast(ASRUtils::symbol_get_past_external(x->m_name)); + ASR::symbol_t* res = sum->m_symtab->resolve_symbol("result"); + if (res) { + ASR::ttype_t* type = ASRUtils::duplicate_type(al, x->m_type); + ASR::Array_t* res_arr = ASR::down_cast(type); + for (size_t i = 0; i < res_arr->n_dims; i++) { + if (ASR::is_a(*res_arr->m_dims[i].m_length)) { + func_call_merge = res_arr->m_dims[i].m_length; + ASR::FunctionCall_t* func_call = ASR::down_cast(func_call_merge); + if (ASR::is_a(*func_call->m_args[0].m_value)) { + ASR::ArraySize_t *array_size = ASR::down_cast(func_call->m_args[0].m_value); + array_size->m_v = ASR::down_cast(new_args[map[0]].m_value)->m_arg; + func_call->m_args[0].m_value = ASRUtils::EXPR((ASR::asr_t*) array_size); + } + if (ASR::is_a(*func_call->m_args[1].m_value)) { + ASR::ArraySize_t *array_size = ASR::down_cast(func_call->m_args[1].m_value); + array_size->m_v = ASR::down_cast(new_args[map[1]].m_value)->m_arg; + + func_call->m_args[1].m_value = ASRUtils::EXPR((ASR::asr_t*) array_size); + } + if (ASR::is_a(*func_call->m_args[2].m_value)) { + ASR::IntegerCompare_t *integer_compare = ASR::down_cast(func_call->m_args[2].m_value); + integer_compare->m_right = new_args[map[2]].m_value; + + func_call->m_args[2].m_value = ASRUtils::EXPR((ASR::asr_t*) integer_compare); + } + res_arr->m_dims[i].m_length = func_call_merge; + } + } + if (func_call_merge) { + // allocate result array + Vec alloc_args; alloc_args.reserve(al, 1); + ASR::alloc_arg_t alloc_arg; alloc_arg.loc = x->base.base.loc; + alloc_arg.m_a = result_var_; alloc_arg.m_len_expr = nullptr; + alloc_arg.m_type = nullptr; alloc_arg.m_dims = res_arr->m_dims; + alloc_arg.n_dims = res_arr->n_dims; + alloc_args.push_back(al, alloc_arg); + + ASR::stmt_t* allocate_stmt = ASRUtils::STMT(ASR::make_Allocate_t(al, + x->base.base.loc, alloc_args.p, alloc_args.n, nullptr, nullptr, nullptr)); + pass_result.push_back(al, allocate_stmt); + } + } + } + + static inline ASR::expr_t* get_actual_arg_(ASR::expr_t* arg, Vec& func_call_args, Vec actual_args) { + if (!ASR::is_a(*arg)) return arg; + std::string arg_name = ASRUtils::symbol_name(ASR::down_cast(arg)->m_v); + for (size_t i = 0; i < func_call_args.size(); i++) { + ASR::expr_t* func_arg = func_call_args[i].m_value; + if (func_arg == nullptr) { + continue; + } + if (ASR::is_a(*func_arg)) { + func_arg = ASR::down_cast(func_arg)->m_arg; + } + if (ASR::is_a(*func_arg)) { + std::string func_arg_name = ASRUtils::symbol_name(ASR::down_cast(func_arg)->m_v); + if (arg_name == func_arg_name) { + return actual_args[i]; + } + } + } + return arg; } template @@ -262,6 +361,7 @@ namespace LCompilers { bool fill_function_dependencies; bool fill_module_dependencies; bool fill_variable_dependencies; + bool _return_var_or_intent_out = false; SymbolTable* current_scope; public: @@ -322,7 +422,11 @@ namespace LCompilers { variable_dependencies.reserve(al, 1); bool fill_variable_dependencies_copy = fill_variable_dependencies; fill_variable_dependencies = true; + _return_var_or_intent_out = (x.m_intent == ASR::intentType::Out || + x.m_intent == ASR::intentType::ReturnVar || + x.m_intent == ASR::intentType::InOut); BaseWalkVisitor::visit_Variable(x); + _return_var_or_intent_out = false; xx.n_dependencies = variable_dependencies.size(); xx.m_dependencies = variable_dependencies.p; fill_variable_dependencies = fill_variable_dependencies_copy; @@ -354,6 +458,11 @@ namespace LCompilers { function_dependencies.push_back(al, ASRUtils::symbol_name(x.m_name)); } } + + if (_return_var_or_intent_out && temp_scope->get_counter() != ASRUtils::symbol_parent_symtab(x.m_name)->get_counter() && + !ASR::is_a(*x.m_name)) { + function_dependencies.push_back(al, ASRUtils::symbol_name(x.m_name)); + } } if( ASR::is_a(*x.m_name) && fill_module_dependencies ) { @@ -610,11 +719,12 @@ namespace LCompilers { idoloop_m_values_i, cast_kind, casted_type, nullptr)); } ASR::stmt_t* doloop_stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, arr_var->base.loc, - array_ref, idoloop->m_values[i], nullptr)); + array_ref, idoloop_m_values_i, nullptr)); doloop_body.push_back(al, doloop_stmt); if( arr_idx != nullptr ) { + ASR::expr_t* one = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, arr_var->base.loc, 1, ASRUtils::TYPE(ASR::make_Integer_t(al, arr_var->base.loc, 4)))); ASR::expr_t* increment = ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, arr_var->base.loc, - arr_idx, ASR::binopType::Add, const_1, ASRUtils::expr_type(arr_idx), nullptr)); + arr_idx, ASR::binopType::Add, one, ASRUtils::expr_type(arr_idx), nullptr)); ASR::stmt_t* assign_stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, arr_var->base.loc, arr_idx, increment, nullptr)); doloop_body.push_back(al, assign_stmt); @@ -622,7 +732,7 @@ namespace LCompilers { } } ASR::stmt_t* doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, arr_var->base.loc, - nullptr, head, doloop_body.p, doloop_body.size())); + nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); result_vec->push_back(al, doloop); } @@ -651,7 +761,7 @@ namespace LCompilers { doloop_body.push_back(al, doloop); } doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, - doloop_body.p, doloop_body.size())); + doloop_body.p, doloop_body.size(), nullptr, 0)); } result_vec->push_back(al, doloop); } @@ -684,7 +794,7 @@ namespace LCompilers { doloop_body.push_back(al, doloop); } doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, - doloop_body.p, doloop_body.size())); + doloop_body.p, doloop_body.size(), nullptr, 0)); } result_vec->push_back(al, doloop); } @@ -695,6 +805,12 @@ namespace LCompilers { bool perform_cast=false, ASR::cast_kindType cast_kind=ASR::cast_kindType::IntegerToInteger, ASR::ttype_t* casted_type=nullptr); + void visit_ArrayConstructor(ASR::ArrayConstructor_t* x, Allocator& al, + ASR::expr_t* arr_var, Vec* result_vec, + ASR::expr_t* idx_var, SymbolTable* current_scope, + bool perform_cast=false, ASR::cast_kindType cast_kind=ASR::cast_kindType::IntegerToInteger, + ASR::ttype_t* casted_type=nullptr); + template static inline void replace_ArrayConstant(ASR::ArrayConstant_t* x, T* replacer, bool& remove_original_statement, Vec* result_vec, @@ -741,6 +857,106 @@ namespace LCompilers { "dimension sliced are supported for now."); } + Vec idx_vars; + PassUtils::create_idx_vars(idx_vars, 1, loc, replacer->al, replacer->current_scope); + ASR::expr_t* idx_var = idx_vars[0]; + ASR::expr_t* lb = PassUtils::get_bound(target_section->m_v, sliced_dim_index, "lbound", replacer->al); + ASR::expr_t* const_1 = ASRUtils::EXPR(ASR::make_IntegerConstant_t(replacer->al, loc, 1, + ASRUtils::expr_type(idx_var))); + ASR::stmt_t* assign_stmt = ASRUtils::STMT(ASR::make_Assignment_t(replacer->al, + target_section->base.base.loc, idx_var, lb, nullptr)); + result_vec->push_back(replacer->al, assign_stmt); + for( size_t k = 0; k < x->n_args; k++ ) { + Vec args; + args.reserve(replacer->al, target_section->n_args); + for( size_t i = 0; i < target_section->n_args; i++ ) { + if( i + 1 == sliced_dim_index ) { + ASR::array_index_t ai; + ai.loc = target_section->base.base.loc; + ai.m_left = nullptr; + ai.m_step = nullptr; + ai.m_right = idx_var; + args.push_back(replacer->al, ai); + } else { + args.push_back(replacer->al, target_section->m_args[i]); + } + } + + ASR::ttype_t* array_ref_type = ASRUtils::expr_type(replacer->result_var); + Vec empty_dims; + empty_dims.reserve(replacer->al, 1); + array_ref_type = ASRUtils::duplicate_type(replacer->al, array_ref_type, &empty_dims); + + ASR::expr_t* array_ref = ASRUtils::EXPR(ASRUtils::make_ArrayItem_t_util(replacer->al, + target_section->base.base.loc, + target_section->m_v, + args.p, args.size(), + ASRUtils::type_get_past_pointer( + ASRUtils::type_get_past_allocatable(array_ref_type)), + ASR::arraystorageType::RowMajor, nullptr)); + ASR::expr_t* x_m_args_k = x->m_args[k]; + if( perform_cast ) { + LCOMPILERS_ASSERT(casted_type != nullptr); + x_m_args_k = ASRUtils::EXPR(ASR::make_Cast_t(replacer->al, array_ref->base.loc, + x_m_args_k, cast_kind, casted_type, nullptr)); + } + ASR::stmt_t* assign_stmt = ASRUtils::STMT(ASR::make_Assignment_t(replacer->al, target_section->base.base.loc, + array_ref, x_m_args_k, nullptr)); + result_vec->push_back(replacer->al, assign_stmt); + ASR::expr_t* increment = ASRUtils::EXPR(ASR::make_IntegerBinOp_t(replacer->al, target_section->base.base.loc, + idx_var, ASR::binopType::Add, const_1, ASRUtils::expr_type(idx_var), nullptr)); + assign_stmt = ASRUtils::STMT(ASR::make_Assignment_t(replacer->al, target_section->base.base.loc, idx_var, increment, nullptr)); + result_vec->push_back(replacer->al, assign_stmt); + } + } + } + + template + static inline void replace_ArrayConstructor(ASR::ArrayConstructor_t* x, T* replacer, + bool& remove_original_statement, Vec* result_vec, + bool perform_cast=false, + ASR::cast_kindType cast_kind=ASR::cast_kindType::IntegerToInteger, + ASR::ttype_t* casted_type=nullptr) { + LCOMPILERS_ASSERT(replacer->result_var != nullptr); + if( x->n_args == 0 ) { + remove_original_statement = true; + return ; + } + + const Location& loc = x->base.base.loc; + if( ASR::is_a(*replacer->result_var) ) { + [[maybe_unused]] ASR::ttype_t* result_var_type = ASRUtils::expr_type(replacer->result_var); + LCOMPILERS_ASSERT_MSG(ASRUtils::extract_n_dims_from_ttype(result_var_type) == 1, + "Initialisation using ArrayConstructor is " + "supported only for single dimensional arrays, found: " + + std::to_string(ASRUtils::extract_n_dims_from_ttype(result_var_type))) + Vec idx_vars; + PassUtils::create_idx_vars(idx_vars, 1, loc, replacer->al, replacer->current_scope); + ASR::expr_t* idx_var = idx_vars[0]; + ASR::expr_t* lb = PassUtils::get_bound(replacer->result_var, 1, "lbound", replacer->al); + ASR::stmt_t* assign_stmt = ASRUtils::STMT(ASR::make_Assignment_t(replacer->al, + loc, idx_var, lb, nullptr)); + result_vec->push_back(replacer->al, assign_stmt); + visit_ArrayConstructor(x, replacer->al, replacer->result_var, result_vec, + idx_var, replacer->current_scope, + perform_cast, cast_kind, casted_type); + } else if( ASR::is_a(*replacer->result_var) ) { + ASR::ArraySection_t* target_section = ASR::down_cast(replacer->result_var); + int sliced_dims_count = 0; + size_t sliced_dim_index = 0; + for( size_t i = 0; i < target_section->n_args; i++ ) { + if( !(target_section->m_args[i].m_left == nullptr && + target_section->m_args[i].m_right != nullptr && + target_section->m_args[i].m_step == nullptr) ) { + sliced_dims_count += 1; + sliced_dim_index = i + 1; + } + } + if( sliced_dims_count != 1 ) { + throw LCompilersException("Target expressions only having one " + "dimension sliced are supported for now."); + } + Vec idx_vars; PassUtils::create_idx_vars(idx_vars, 1, loc, replacer->al, replacer->current_scope); ASR::expr_t* idx_var = idx_vars[0]; @@ -802,7 +1018,7 @@ namespace LCompilers { } static inline void handle_fn_return_var(Allocator &al, ASR::Function_t *x, - bool (*is_array_or_struct)(ASR::expr_t*)) { + bool (*is_array_or_struct_or_symbolic)(ASR::expr_t*)) { if (ASRUtils::get_FunctionType(x)->m_abi == ASR::abiType::BindPython) { return; } @@ -814,7 +1030,7 @@ namespace LCompilers { * in avoiding deep copies and the destination memory directly gets * filled inside the function. */ - if( is_array_or_struct(x->m_return_var)) { + if( is_array_or_struct_or_symbolic(x->m_return_var) || is_symbolic_list_type(x->m_return_var)) { for( auto& s_item: x->m_symtab->get_scope() ) { ASR::symbol_t* curr_sym = s_item.second; if( curr_sym->type == ASR::symbolType::Variable ) { @@ -853,7 +1069,7 @@ namespace LCompilers { for (auto &item : x->m_symtab->get_scope()) { if (ASR::is_a(*item.second)) { handle_fn_return_var(al, ASR::down_cast( - item.second), is_array_or_struct); + item.second), is_array_or_struct_or_symbolic); } } } diff --git a/src/libasr/pass/print_arr.cpp b/src/libasr/pass/print_arr.cpp index 0755423..4031f6d 100644 --- a/src/libasr/pass/print_arr.cpp +++ b/src/libasr/pass/print_arr.cpp @@ -84,7 +84,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor print_args.push_back(al, ref); ASR::stmt_t* print_stmt = nullptr; if (format != nullptr) { - ASR::expr_t* string_format = ASRUtils::EXPR(ASR::make_StringFormat_t(al, format->base.base.loc, + ASR::expr_t* string_format = ASRUtils::EXPR(ASRUtils::make_StringFormat_t_util(al, format->base.base.loc, format->m_fmt, print_args.p, print_args.size(), ASR::string_format_kindType::FormatFortran, format->m_type, format->m_value)); Vec format_args; @@ -92,6 +92,9 @@ class PrintArrVisitor : public PassUtils::PassVisitor format_args.push_back(al, string_format); print_stmt = ASRUtils::STMT(ASR::make_Print_t(al, loc, format_args.p, format_args.size(), nullptr, empty_space)); + } else if (ASR::is_a(*ASRUtils::type_get_past_allocatable(ASRUtils::type_get_past_array(ASRUtils::expr_type(print_args[0]))))) { + print_stmt = ASRUtils::STMT(ASR::make_Print_t(al, loc, + print_args.p, print_args.size(), nullptr, empty_space)); } else { print_stmt = ASRUtils::STMT(ASR::make_Print_t(al, loc, print_args.p, print_args.size(), nullptr, space)); @@ -101,7 +104,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor doloop_body.push_back(al, doloop); doloop_body.push_back(al, empty_print_endl); } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } return doloop; } @@ -127,13 +130,13 @@ class PrintArrVisitor : public PassUtils::PassVisitor } ASR::stmt_t* create_formatstmt(std::vector &print_body, ASR::StringFormat_t* format, const Location &loc, ASR::stmtType _type, - ASR::expr_t* unit = nullptr, ASR::expr_t* separator = nullptr, ASR::expr_t* end = nullptr) { + ASR::expr_t* unit = nullptr, ASR::expr_t* separator = nullptr, ASR::expr_t* end = nullptr, ASR::stmt_t* overloaded = nullptr) { Vec body; body.reserve(al, print_body.size()); for (size_t j=0; jbase.base.loc, + ASR::expr_t* string_format = ASRUtils::EXPR(ASRUtils::make_StringFormat_t_util(al, format->base.base.loc, format->m_fmt, body.p, body.size(), ASR::string_format_kindType::FormatFortran, format->m_type, nullptr)); Vec print_args; @@ -145,7 +148,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor print_args.p, print_args.size(), nullptr, nullptr)); } else if (_type == ASR::stmtType::FileWrite) { statement = ASRUtils::STMT(ASR::make_FileWrite_t(al, loc, 0, unit, - nullptr, nullptr, nullptr, print_args.p, print_args.size(), separator, end)); + nullptr, nullptr, nullptr, print_args.p, print_args.size(), separator, end, overloaded)); } print_body.clear(); return statement; @@ -155,7 +158,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor std::vector print_body; ASR::stmt_t* empty_print_endl; ASR::stmt_t* print_stmt; - if (x.m_values[0] != nullptr && ASR::is_a(*x.m_values[0])) { + if (x.n_values > 0 && ASR::is_a(*x.m_values[0])) { empty_print_endl = ASRUtils::STMT(ASR::make_Print_t(al, x.base.base.loc, nullptr, 0, nullptr, nullptr)); ASR::StringFormat_t* format = ASR::down_cast(x.m_values[0]); @@ -262,7 +265,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor ASR::expr_t *empty_space = ASRUtils::EXPR(ASR::make_StringConstant_t( al, loc, s2c(al, ""), str_type_len)); ASR::stmt_t* empty_file_write_endl = ASRUtils::STMT(ASR::make_FileWrite_t(al, loc, - 0, unit, nullptr, nullptr, nullptr, nullptr, 0, nullptr, nullptr)); + 0, unit, nullptr, nullptr, nullptr, nullptr, 0, nullptr, nullptr, nullptr)); for( int i = n_dims - 1; i >= 0; i-- ) { ASR::do_loop_head_t head; head.m_v = idx_vars[i]; @@ -279,7 +282,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor print_args.push_back(al, ref); ASR::stmt_t* write_stmt = nullptr; if (format != nullptr) { - ASR::expr_t* string_format = ASRUtils::EXPR(ASR::make_StringFormat_t(al, format->base.base.loc, + ASR::expr_t* string_format = ASRUtils::EXPR(ASRUtils::make_StringFormat_t_util(al, format->base.base.loc, format->m_fmt, print_args.p, print_args.size(), ASR::string_format_kindType::FormatFortran, format->m_type, format->m_value)); Vec format_args; @@ -287,18 +290,18 @@ class PrintArrVisitor : public PassUtils::PassVisitor format_args.push_back(al, string_format); write_stmt = ASRUtils::STMT(ASR::make_FileWrite_t( al, loc, i, unit, nullptr, nullptr, nullptr, - format_args.p, format_args.size(), nullptr, empty_space)); + format_args.p, format_args.size(), nullptr, empty_space, nullptr)); } else { write_stmt = ASRUtils::STMT(ASR::make_FileWrite_t( al, loc, i, unit, nullptr, nullptr, nullptr, - print_args.p, print_args.size(), nullptr, nullptr)); + print_args.p, print_args.size(), nullptr, nullptr, nullptr)); } doloop_body.push_back(al, write_stmt); } else { doloop_body.push_back(al, doloop); doloop_body.push_back(al, empty_file_write_endl); } - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, nullptr, head, doloop_body.p, doloop_body.size(), nullptr, 0)); } return doloop; } @@ -308,7 +311,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor body.from_pointer_n_copy(al, write_body.data(), write_body.size()); ASR::stmt_t* write_stmt = ASRUtils::STMT(ASR::make_FileWrite_t( al, x.base.base.loc, x.m_label, x.m_unit, x.m_iomsg, - x.m_iostat, x.m_id, body.p, body.size(), x.m_separator, x.m_end)); + x.m_iostat, x.m_id, body.p, body.size(), x.m_separator, x.m_end, x.m_overloaded)); pass_result.push_back(al, write_stmt); write_body.clear(); } @@ -321,7 +324,7 @@ class PrintArrVisitor : public PassUtils::PassVisitor std::vector write_body; ASR::stmt_t* write_stmt; ASR::stmt_t* empty_file_write_endl = ASRUtils::STMT(ASR::make_FileWrite_t(al, x.base.base.loc, - x.m_label, x.m_unit, nullptr, nullptr, nullptr, nullptr, 0, nullptr, nullptr)); + x.m_label, x.m_unit, nullptr, nullptr, nullptr, nullptr, 0, nullptr, nullptr, nullptr)); if(x.m_values && x.m_values[0] != nullptr && ASR::is_a(*x.m_values[0])){ ASR::StringFormat_t* format = ASR::down_cast(x.m_values[0]); for (size_t i=0; in_args; i++) { @@ -330,7 +333,9 @@ class PrintArrVisitor : public PassUtils::PassVisitor print_fixed_sized_array(format->m_args[i], write_body, x.base.base.loc); } else { if (write_body.size() > 0) { - write_stmt = create_formatstmt(write_body, format, x.base.base.loc, ASR::stmtType::FileWrite, x.m_unit, x.m_separator, x.m_end); + write_stmt = create_formatstmt(write_body, format, + x.base.base.loc, ASR::stmtType::FileWrite, x.m_unit, x.m_separator, + x.m_end, x.m_overloaded); pass_result.push_back(al, write_stmt); } write_stmt = write_array_using_doloop(format->m_args[i], format, x.m_unit, x.base.base.loc); @@ -342,7 +347,9 @@ class PrintArrVisitor : public PassUtils::PassVisitor } } if (write_body.size() > 0) { - write_stmt = create_formatstmt(write_body, format, x.base.base.loc, ASR::stmtType::FileWrite, x.m_unit, x.m_separator, x.m_end); + write_stmt = create_formatstmt(write_body, format, x.base.base.loc, + ASR::stmtType::FileWrite, x.m_unit, x.m_separator, + x.m_end, x.m_overloaded); pass_result.push_back(al, write_stmt); } return; diff --git a/src/libasr/pass/print_list_tuple.cpp b/src/libasr/pass/print_list_tuple.cpp index 84cf51b..9b977b8 100644 --- a/src/libasr/pass/print_list_tuple.cpp +++ b/src/libasr/pass/print_list_tuple.cpp @@ -196,7 +196,7 @@ class PrintListTupleVisitor } ASR::stmt_t *loop = ASRUtils::STMT(ASR::make_DoLoop_t( - al, loc, nullptr, loop_head, loop_body.p, loop_body.size())); + al, loc, nullptr, loop_head, loop_body.p, loop_body.size(), nullptr, 0)); { print_pass_result_tmp.push_back(al, print_open_bracket); diff --git a/src/libasr/pass/promote_allocatable_to_nonallocatable.cpp b/src/libasr/pass/promote_allocatable_to_nonallocatable.cpp new file mode 100644 index 0000000..d7aba6c --- /dev/null +++ b/src/libasr/pass/promote_allocatable_to_nonallocatable.cpp @@ -0,0 +1,278 @@ +#include +#include +#include +#include +#include +#include + +#include + +namespace LCompilers { + +class IsAllocatedCalled: public ASR::CallReplacerOnExpressionsVisitor { + public: + + std::map>& scope2var; + + IsAllocatedCalled(std::map>& scope2var_): + scope2var(scope2var_) {} + + void visit_IntrinsicImpureFunction(const ASR::IntrinsicImpureFunction_t& x) { + if( x.m_impure_intrinsic_id == static_cast( + ASRUtils::IntrinsicImpureFunctions::Allocated) ) { + LCOMPILERS_ASSERT(x.n_args == 1); + if( ASR::is_a(*x.m_args[0]) ) { + scope2var[current_scope].push_back( + ASR::down_cast(x.m_args[0])->m_v); + } + } + } + + void visit_FunctionCall(const ASR::FunctionCall_t& x) { + ASR::FunctionType_t* func_type = ASRUtils::get_FunctionType(x.m_name); + for( size_t i = 0; i < x.n_args; i++ ) { + if( ASR::is_a(*func_type->m_arg_types[i]) || + ASR::is_a(*func_type->m_arg_types[i]) ) { + if( ASR::is_a(*x.m_args[i].m_value) ) { + scope2var[current_scope].push_back( + ASR::down_cast(x.m_args[i].m_value)->m_v); + } + } + } + } + + void visit_SubroutineCall(const ASR::SubroutineCall_t& x) { + ASR::FunctionType_t* func_type = ASRUtils::get_FunctionType(x.m_name); + for( size_t i = 0; i < x.n_args; i++ ) { + if( ASR::is_a(*func_type->m_arg_types[i]) || + ASR::is_a(*func_type->m_arg_types[i]) ) { + if( ASR::is_a(*x.m_args[i].m_value) ) { + scope2var[current_scope].push_back( + ASR::down_cast(x.m_args[i].m_value)->m_v); + } + } + } + } + + void visit_ReAlloc(const ASR::ReAlloc_t& x) { + for( size_t i = 0; i < x.n_args; i++ ) { + if( ASR::is_a(*ASRUtils::expr_type(x.m_args[i].m_a)) || + ASR::is_a(*ASRUtils::expr_type(x.m_args[i].m_a)) ) { + if( ASR::is_a(*x.m_args[i].m_a) ) { + scope2var[current_scope].push_back( + ASR::down_cast(x.m_args[i].m_a)->m_v); + } + } + } + } + + void visit_Allocate(const ASR::Allocate_t& x) { + for( size_t i = 0; i < x.n_args; i++ ) { + ASR::alloc_arg_t alloc_arg = x.m_args[i]; + if( !ASRUtils::is_dimension_dependent_only_on_arguments( + alloc_arg.m_dims, alloc_arg.n_dims) ) { + if( ASR::is_a(*alloc_arg.m_a) ) { + scope2var[current_scope].push_back( + ASR::down_cast(alloc_arg.m_a)->m_v); + } + } + } + } + +}; + +class PromoteAllocatableToNonAllocatable: + public ASR::CallReplacerOnExpressionsVisitor +{ + private: + + Allocator& al; + bool remove_original_statement; + + public: + + std::map>& scope2var; + + PromoteAllocatableToNonAllocatable(Allocator& al_, + std::map>& scope2var_): + al(al_), remove_original_statement(false), scope2var(scope2var_) {} + + void visit_Allocate(const ASR::Allocate_t& x) { + ASR::Allocate_t& xx = const_cast(x); + Vec x_args; + x_args.reserve(al, x.n_args); + for( size_t i = 0; i < x.n_args; i++ ) { + ASR::alloc_arg_t alloc_arg = x.m_args[i]; + if( ASR::is_a(*alloc_arg.m_a) && + ASR::is_a(*ASRUtils::expr_type(alloc_arg.m_a)) && + ASRUtils::is_array(ASRUtils::expr_type(alloc_arg.m_a)) && + ASR::is_a( + *ASR::down_cast(alloc_arg.m_a)->m_v) && + ASRUtils::expr_intent(alloc_arg.m_a) == ASRUtils::intent_local && + ASRUtils::is_dimension_dependent_only_on_arguments( + alloc_arg.m_dims, alloc_arg.n_dims) && + std::find(scope2var[current_scope].begin(), + scope2var[current_scope].end(), + ASR::down_cast(alloc_arg.m_a)->m_v) == + scope2var[current_scope].end() ) { + ASR::Variable_t* alloc_variable = ASR::down_cast( + ASR::down_cast(alloc_arg.m_a)->m_v); + alloc_variable->m_type = ASRUtils::make_Array_t_util(al, x.base.base.loc, + ASRUtils::type_get_past_array( + ASRUtils::type_get_past_allocatable(alloc_variable->m_type)), + alloc_arg.m_dims, alloc_arg.n_dims); + } else if( ASR::is_a(*ASRUtils::expr_type(alloc_arg.m_a)) || + ASR::is_a(*ASRUtils::expr_type(alloc_arg.m_a)) ) { + x_args.push_back(al, alloc_arg); + } + } + if( x_args.size() > 0 ) { + xx.m_args = x_args.p; + xx.n_args = x_args.size(); + } else { + remove_original_statement = true; + } + } + + template + void visit_Deallocate(const T& x) { + T& xx = const_cast(x); + Vec x_args; + x_args.reserve(al, x.n_vars); + for( size_t i = 0; i < x.n_vars; i++ ) { + if( ASR::is_a( + *ASRUtils::expr_type(x.m_vars[i])) || + ASR::is_a( + *ASRUtils::expr_type(x.m_vars[i])) ) { + x_args.push_back(al, x.m_vars[i]); + } + } + if( x_args.size() > 0 ) { + xx.m_vars = x_args.p; + xx.n_vars = x_args.size(); + } else { + remove_original_statement = true; + } + } + + void visit_ExplicitDeallocate(const ASR::ExplicitDeallocate_t& x) { + visit_Deallocate(x); + } + + void visit_ImplicitDeallocate(const ASR::ImplicitDeallocate_t& x) { + visit_Deallocate(x); + } + + void transform_stmts(ASR::stmt_t **&m_body, size_t &n_body) { + bool remove_original_statement_copy = remove_original_statement; + Vec body; + body.reserve(al, n_body); + for (size_t i = 0; i < n_body; i++) { + remove_original_statement = false; + visit_stmt(*m_body[i]); + if( !remove_original_statement ) { + body.push_back(al, m_body[i]); + } + } + m_body = body.p; + n_body = body.size(); + remove_original_statement = remove_original_statement_copy; + } + +}; + +class FixArrayPhysicalCast: public ASR::BaseExprReplacer { + private: + Allocator& al; + + public: + + FixArrayPhysicalCast(Allocator& al_): al(al_) {} + + void replace_ArrayPhysicalCast(ASR::ArrayPhysicalCast_t* x) { + ASR::BaseExprReplacer::replace_ArrayPhysicalCast(x); + if( x->m_old != ASRUtils::extract_physical_type(ASRUtils::expr_type(x->m_arg)) ) { + x->m_old = ASRUtils::extract_physical_type(ASRUtils::expr_type(x->m_arg)); + } + if( (x->m_old == x->m_new && + x->m_old != ASR::array_physical_typeType::DescriptorArray) || + (x->m_old == x->m_new && x->m_old == ASR::array_physical_typeType::DescriptorArray && + (ASR::is_a(*ASRUtils::expr_type(x->m_arg)) || + ASR::is_a(*ASRUtils::expr_type(x->m_arg))) ) ) { + *current_expr = x->m_arg; + } + } + + void replace_FunctionCall(ASR::FunctionCall_t* x) { + ASR::BaseExprReplacer::replace_FunctionCall(x); + ASR::expr_t* call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util( + al, x->base.base.loc, x->m_name, x->m_original_name, x->m_args, + x->n_args, x->m_type, x->m_value, x->m_dt)); + ASR::FunctionCall_t* function_call = ASR::down_cast(call); + x->m_args = function_call->m_args; + x->n_args = function_call->n_args; + } + + void replace_ArrayReshape(ASR::ArrayReshape_t* x) { + ASR::BaseExprReplacer::replace_ArrayReshape(x); + if( ASRUtils::extract_physical_type(ASRUtils::expr_type(x->m_array)) == + ASR::array_physical_typeType::FixedSizeArray && + ASRUtils::extract_physical_type(x->m_type) != + ASR::array_physical_typeType::FixedSizeArray ) { + size_t n_dims = ASRUtils::extract_n_dims_from_ttype(x->m_type); + Vec 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 = x->base.base.loc; + empty_dim.m_start = nullptr; + empty_dim.m_length = nullptr; + empty_dims.push_back(al, empty_dim); + } + x->m_type = ASRUtils::TYPE(ASR::make_Array_t(al, x->base.base.loc, + ASRUtils::extract_type(x->m_type), empty_dims.p, empty_dims.size(), + ASR::array_physical_typeType::FixedSizeArray)); + } + } +}; + +class FixArrayPhysicalCastVisitor: public ASR::CallReplacerOnExpressionsVisitor { + public: + + Allocator& al; + FixArrayPhysicalCast replacer; + + FixArrayPhysicalCastVisitor(Allocator& al_): al(al_), replacer(al_) {} + + void call_replacer() { + replacer.current_expr = current_expr; + replacer.replace_expr(*current_expr); + } + + void visit_SubroutineCall(const ASR::SubroutineCall_t& x) { + ASR::CallReplacerOnExpressionsVisitor::visit_SubroutineCall(x); + ASR::stmt_t* call = ASRUtils::STMT(ASRUtils::make_SubroutineCall_t_util( + al, x.base.base.loc, x.m_name, x.m_original_name, x.m_args, + x.n_args, x.m_dt, nullptr, false, ASRUtils::get_class_proc_nopass_val(x.m_name))); + ASR::SubroutineCall_t* subrout_call = ASR::down_cast(call); + ASR::SubroutineCall_t& xx = const_cast(x); + xx.m_args = subrout_call->m_args; + xx.n_args = subrout_call->n_args; + } +}; + +void pass_promote_allocatable_to_nonallocatable( + Allocator &al, ASR::TranslationUnit_t &unit, + const PassOptions &/*pass_options*/) { + std::map> scope2var; + IsAllocatedCalled is_allocated_called(scope2var); + is_allocated_called.visit_TranslationUnit(unit); + PromoteAllocatableToNonAllocatable promoter(al, scope2var); + promoter.visit_TranslationUnit(unit); + promoter.visit_TranslationUnit(unit); + FixArrayPhysicalCastVisitor fix_array_physical_cast(al); + fix_array_physical_cast.visit_TranslationUnit(unit); + PassUtils::UpdateDependenciesVisitor u(al); + u.visit_TranslationUnit(unit); +} + +} // namespace LCompilers diff --git a/src/libasr/pass/promote_allocatable_to_nonallocatable.h b/src/libasr/pass/promote_allocatable_to_nonallocatable.h new file mode 100644 index 0000000..e15dc70 --- /dev/null +++ b/src/libasr/pass/promote_allocatable_to_nonallocatable.h @@ -0,0 +1,14 @@ +#ifndef LIBASR_PASS_PROMOTE_ALLOCATABLE_TO_NONALLOCATABLE_H +#define LIBASR_PASS_PROMOTE_ALLOCATABLE_TO_NONALLOCATABLE_H + +#include +#include + +namespace LCompilers { + + void pass_promote_allocatable_to_nonallocatable(Allocator &al, ASR::TranslationUnit_t &unit, + const PassOptions &pass_options); + +} // namespace LCompilers + +#endif // LIBASR_PASS_PROMOTE_ALLOCATABLE_TO_NONALLOCATABLE_H diff --git a/src/libasr/pass/replace_function_call_in_declaration.h b/src/libasr/pass/replace_function_call_in_declaration.h new file mode 100644 index 0000000..2b5be55 --- /dev/null +++ b/src/libasr/pass/replace_function_call_in_declaration.h @@ -0,0 +1,14 @@ +#ifndef LIBASR_PASS_REPLACE_FUNCTION_CALL_IN_DECLARATION_H +#define LIBASR_PASS_REPLACE_FUNCTION_CALL_IN_DECLARATION_H + +#include +#include + +namespace LCompilers { + + void pass_replace_function_call_in_declaration(Allocator &al, ASR::TranslationUnit_t &unit, + const PassOptions &pass_options); + +} // namespace LCompilers + +#endif // LIBASR_PASS_REPLACE_FUNCTION_CALL_IN_DECLARATION_H diff --git a/src/libasr/pass/replace_intrinsic_subroutine.h b/src/libasr/pass/replace_intrinsic_subroutine.h new file mode 100644 index 0000000..7d11dec --- /dev/null +++ b/src/libasr/pass/replace_intrinsic_subroutine.h @@ -0,0 +1,14 @@ +#ifndef LIBASR_PASS_REPLACE_INTRINSIC_SUBROUTINE_H +#define LIBASR_PASS_REPLACE_INTRINSIC_SUBROUTINE_H + +#include +#include + +namespace LCompilers { + + void pass_replace_intrinsic_subroutine(Allocator &al, ASR::TranslationUnit_t &unit, + const PassOptions &pass_options); + +} // namespace LCompilers + +#endif // LIBASR_PASS_REPLACE_INTRINSIC_SUBROUTINE_H diff --git a/src/libasr/pass/replace_symbolic.cpp b/src/libasr/pass/replace_symbolic.cpp index 43a828f..6e4aa5a 100644 --- a/src/libasr/pass/replace_symbolic.cpp +++ b/src/libasr/pass/replace_symbolic.cpp @@ -6,6 +6,7 @@ #include #include #include +#include namespace LCompilers { @@ -49,20 +50,263 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor symbolic_vars_to_omit; SymEngine_Stack symengine_stack; + /********************************** Utils *********************************/ + #define BASIC_CONST(SYM, name) \ + case LCompilers::ASRUtils::IntrinsicElementalFunctions::Symbolic##SYM: { \ + pass_result.push_back(al, basic_const(loc, \ + "basic_const_"#name, target)); \ + break; } + + #define BASIC_BINOP(SYM, name) \ + case LCompilers::ASRUtils::IntrinsicElementalFunctions::Symbolic##SYM: { \ + pass_result.push_back(al, basic_binop(loc, "basic_"#name, target, \ + x->m_args[0], x->m_args[1])); \ + break; } + + #define BASIC_UNARYOP(SYM, name) \ + case LCompilers::ASRUtils::IntrinsicElementalFunctions::Symbolic##SYM: { \ + pass_result.push_back(al, basic_unaryop(loc, "basic_"#name, \ + target, x->m_args[0])); \ + break; } + + #define BASIC_ATTR(SYM, N) \ + case LCompilers::ASRUtils::IntrinsicElementalFunctions::Symbolic##SYM: { \ + ASR::expr_t* function_call = basic_get_type(loc, \ + intrinsic_func->m_args[0]); \ + return b.iEq(function_call, b.i32(N)); } + + ASR::stmt_t *SubroutineCall(const Location &loc, ASR::symbol_t *sym, + std::vector args) { + Vec call_args; call_args.reserve(al, args.size()); + for (auto &x: args) { + ASR::call_arg_t call_arg; + call_arg.loc = loc; + call_arg.m_value = x; + call_args.push_back(al, call_arg); + } + return ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, sym, + sym, call_args.p, call_args.n, nullptr)); + } + + ASR::expr_t *FunctionCall(const Location &loc, ASR::symbol_t *sym, + std::vector args, ASR::ttype_t *return_type) { + Vec call_args; call_args.reserve(al, args.size()); + for (auto &x: args) { + ASR::call_arg_t call_arg; + call_arg.loc = loc; + call_arg.m_value = x; + call_args.push_back(al, call_arg); + } + return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, + sym, sym, call_args.p, call_args.n, return_type, nullptr, nullptr)); + } + + ASR::symbol_t *create_bindc_function(const Location &loc, + const std::string &fn_name, std::vector args_type, + ASR::ttype_t *return_type=nullptr) { + ASRUtils::ASRBuilder b(al, loc); + symbolic_dependencies.push_back(fn_name); + ASR::symbol_t* fn_sym = current_scope->resolve_symbol(fn_name); + if ( !fn_sym ) { + std::string header = "symengine/cwrapper.h"; + SymbolTable *fn_symtab = al.make_new(current_scope->parent); + + Vec args; args.reserve(al, 1); int i = 1; + for (auto &type: args_type) { + std::string arg_name = "x_0" + std::to_string(i); i++; + args.push_back(al, b.Variable(fn_symtab, arg_name, type, + ASR::intentType::In, ASR::abiType::BindC, true)); + } + ASR::expr_t *return_var = nullptr; + if ( return_type ) { + char *return_var_name = s2c(al, "_lpython_return_variable"); + return_var = b.Variable(fn_symtab, return_var_name, return_type, + ASR::intentType::ReturnVar, ASR::abiType::BindC, false); + } + + Vec body; body.reserve(al, 1); + SetChar dep; dep.reserve(al, 1); + fn_sym = ASR::down_cast( ASRUtils::make_Function_t_util( + al, loc, fn_symtab, s2c(al, fn_name), dep.p, dep.n, args.p, args.n, + body.p, body.n, return_var, ASR::abiType::BindC, ASR::accessType::Public, + ASR::deftypeType::Interface, s2c(al, fn_name), false, false, false, + false, false, nullptr, 0, false, false, false, s2c(al, header))); + current_scope->parent->add_symbol(fn_name, fn_sym); + } + return fn_sym; + } + + ASR::stmt_t *basic_new_stack(const Location &loc, ASR::expr_t *x) { + ASR::symbol_t* basic_new_stack_sym = create_bindc_function(loc, "basic_new_stack", + {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}); + return SubroutineCall(loc, basic_new_stack_sym, {x}); + } + + ASR::stmt_t *basic_free_stack(const Location &loc, ASR::expr_t *x) { + ASR::symbol_t* basic_free_stack_sym = create_bindc_function(loc, "basic_free_stack", + {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}); + return SubroutineCall(loc, basic_free_stack_sym, {x}); + } + + ASR::expr_t *basic_new_heap(const Location& loc) { + ASR::symbol_t* basic_new_heap_sym = create_bindc_function(loc, + "basic_new_heap", {}, ASRUtils::TYPE((ASR::make_CPtr_t(al, loc)))); + Vec call_args; call_args.reserve(al, 1); + return FunctionCall(loc, basic_new_heap_sym, {}, + ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))); + } + + ASR::stmt_t* basic_get_args(const Location& loc, ASR::expr_t *x, ASR::expr_t *y) { + ASR::ttype_t *type = ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)); + ASR::symbol_t* basic_get_args_sym = create_bindc_function(loc, + "basic_get_args", {type, type}); + return SubroutineCall(loc, basic_get_args_sym, {x, y}); + } + + ASR::expr_t *vecbasic_new(const Location& loc) { + ASR::symbol_t* vecbasic_new_sym = create_bindc_function(loc, + "vecbasic_new", {}, ASRUtils::TYPE((ASR::make_CPtr_t(al, loc)))); + Vec call_args; call_args.reserve(al, 1); + return FunctionCall(loc, vecbasic_new_sym, {}, + ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))); + } + + ASR::stmt_t* vecbasic_get(const Location& loc, ASR::expr_t *x, ASR::expr_t *y, ASR::expr_t *z) { + ASR::ttype_t *cptr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)); + ASR::symbol_t* vecbasic_get_sym = create_bindc_function(loc, "vecbasic_get", + {cptr_type, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), cptr_type}); + return SubroutineCall(loc, vecbasic_get_sym, {x, y, z}); + } + + ASR::expr_t *vecbasic_size(const Location& loc, ASR::expr_t *x) { + ASR::symbol_t* vecbasic_size_sym = create_bindc_function(loc, + "vecbasic_size", {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}, + ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + return FunctionCall(loc, vecbasic_size_sym, {x}, + ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + } + + ASR::stmt_t* basic_assign(const Location& loc, + ASR::expr_t *target, ASR::expr_t *value) { + ASR::ttype_t *cptr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)); + ASR::symbol_t* basic_assign_sym = create_bindc_function(loc, "basic_assign", + {cptr_type, cptr_type}); + return SubroutineCall(loc, basic_assign_sym, {target, value}); + } + + ASR::expr_t* basic_str(const Location& loc, ASR::expr_t *x) { + ASR::symbol_t* basic_str_sym = create_bindc_function(loc, + "basic_str", {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}, + ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -2, nullptr))); + return FunctionCall(loc, basic_str_sym, {x}, + ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -2, nullptr))); + } + + ASR::expr_t* basic_get_type(const Location& loc, ASR::expr_t* value) { + ASR::symbol_t* basic_get_type_sym = create_bindc_function(loc, + "basic_get_type", {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}, + ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + return FunctionCall(loc, basic_get_type_sym, {handle_argument(al, loc, value)}, + ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4))); + } + + ASR::expr_t* basic_compare(const Location& loc, + std::string fn_name, ASR::expr_t *left, ASR::expr_t *right) { + ASR::symbol_t* basic_compare_sym = create_bindc_function(loc, + fn_name, {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}, + ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + return FunctionCall(loc, basic_compare_sym, {handle_argument(al, loc, left), + handle_argument(al, loc, right)}, ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + } + + ASR::stmt_t* integer_set_si(const Location& loc, ASR::expr_t *target, + ASR::expr_t *value) { + ASR::symbol_t* integer_set_si_sym = create_bindc_function(loc, + "integer_set_si", {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), + ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 8))}); + return SubroutineCall(loc, integer_set_si_sym, {target, value}); + } + + ASR::stmt_t *symbol_set(const Location &loc, ASR::expr_t *target, ASR::expr_t *value) { + ASR::symbol_t* symbol_set_sym = create_bindc_function(loc, "symbol_set", + {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), ASRUtils::TYPE( + ASR::make_Character_t(al, loc, 1, -2, nullptr))}); + return SubroutineCall(loc, symbol_set_sym, {target, value}); + } + + ASR::stmt_t *basic_const(const Location &loc, + const std::string &fn_name, ASR::expr_t* value) { + ASR::symbol_t* basic_const_sym = create_bindc_function(loc, fn_name, + {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}); + return SubroutineCall(loc, basic_const_sym, {value}); + } + + ASR::stmt_t *basic_binop(const Location &loc, const std::string &fn_name, + ASR::expr_t* target, ASR::expr_t* op_01, ASR::expr_t* op_02) { + ASR::ttype_t *cptr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)); + ASR::symbol_t* basic_binop_sym = create_bindc_function(loc, fn_name, + {cptr_type, cptr_type, cptr_type}); + return SubroutineCall(loc, basic_binop_sym, {target, + handle_argument(al, loc, op_01), handle_argument(al, loc, op_02)}); + } + + ASR::stmt_t *basic_unaryop(const Location &loc, const std::string &fn_name, + ASR::expr_t* target, ASR::expr_t* op_01) { + ASR::symbol_t* basic_unaryop_sym = create_bindc_function(loc, fn_name, + {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), ASRUtils::TYPE( + ASR::make_CPtr_t(al, loc))}); + return SubroutineCall(loc, basic_unaryop_sym, {target, + handle_argument(al, loc, op_01)}); + } + + ASR::expr_t *basic_has_symbol(const Location &loc, ASR::expr_t *value_01, ASR::expr_t *value_02) { + ASR::symbol_t* basic_has_symbol_sym = create_bindc_function(loc, + "basic_has_symbol", {ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), ASRUtils::TYPE(ASR::make_CPtr_t(al, loc))}, + ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + return FunctionCall(loc, basic_has_symbol_sym, + {handle_argument(al, loc, value_01), handle_argument(al, loc, value_02)}, + ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4))); + } + + static inline bool is_logical_intrinsic_symbolic(ASR::expr_t* expr) { + if (ASR::is_a(*expr)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(expr); + int64_t intrinsic_id = intrinsic_func->m_intrinsic_id; + switch (static_cast(intrinsic_id)) { + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicHasSymbolQ: + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicAddQ: + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicMulQ: + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicPowQ: + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicLogQ: + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicSinQ: + return true; + default: + return false; + } + } + return true; + } + /********************************** Utils *********************************/ + void visit_Function(const ASR::Function_t &x) { // FIXME: this is a hack, we need to pass in a non-const `x`, // which requires to generate a TransformVisitor. ASR::Function_t &xx = const_cast(x); SymbolTable* current_scope_copy = this->current_scope; this->current_scope = xx.m_symtab; - SymbolTable* module_scope = this->current_scope->parent; ASR::ttype_t* f_signature= xx.m_function_signature; ASR::FunctionType_t *f_type = ASR::down_cast(f_signature); - ASR::ttype_t *type1 = ASRUtils::TYPE(ASR::make_CPtr_t(al, xx.base.base.loc)); + ASR::ttype_t *CPtr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, xx.base.base.loc)); for (size_t i = 0; i < f_type->n_arg_types; ++i) { if (f_type->m_arg_types[i]->type == ASR::ttypeType::SymbolicExpression) { - f_type->m_arg_types[i] = type1; + f_type->m_arg_types[i] = CPtr_type; + } else if (f_type->m_arg_types[i]->type == ASR::ttypeType::List) { + ASR::List_t* list = ASR::down_cast(f_type->m_arg_types[i]); + if (list->m_type->type == ASR::ttypeType::SymbolicExpression){ + ASR::ttype_t* list_type = ASRUtils::TYPE(ASR::make_List_t(al, xx.base.base.loc, CPtr_type)); + f_type->m_arg_types[i] = list_type; + } } } @@ -74,56 +318,41 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorcurrent_scope = current_scope_copy; - // freeing out variables if (!symbolic_vars_to_free.empty()) { - std::string new_name = "basic_free_stack"; - ASR::symbol_t* basic_free_stack_sym = module_scope->get_symbol(new_name); Vec func_body; func_body.from_pointer_n_copy(al, xx.m_body, xx.n_body); for (ASR::symbol_t* symbol : symbolic_vars_to_free) { - if (symbolic_vars_to_omit.find(symbol) != symbolic_vars_to_omit.end()) continue; - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = xx.base.base.loc; - call_arg.m_value = ASRUtils::EXPR(ASR::make_Var_t(al, xx.base.base.loc, symbol)); - call_args.push_back(al, call_arg); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, xx.base.base.loc, basic_free_stack_sym, - basic_free_stack_sym, call_args.p, call_args.n, nullptr)); - func_body.push_back(al, stmt); + func_body.push_back(al, basic_free_stack(x.base.base.loc, + ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, symbol)))); } xx.n_body = func_body.size(); xx.m_body = func_body.p; symbolic_vars_to_free.clear(); } + + SetChar function_dependencies; + function_dependencies.from_pointer_n_copy(al, xx.m_dependencies, xx.n_dependencies); + for( size_t i = 0; i < symbolic_dependencies.size(); i++ ) { + function_dependencies.push_back(al, s2c(al, symbolic_dependencies[i])); + } + symbolic_dependencies.clear(); + xx.n_dependencies = function_dependencies.size(); + xx.m_dependencies = function_dependencies.p; + this->current_scope = current_scope_copy; } void visit_Variable(const ASR::Variable_t& x) { ASR::Variable_t& xx = const_cast(x); if (xx.m_type->type == ASR::ttypeType::SymbolicExpression) { - SymbolTable* module_scope = current_scope->parent; std::string var_name = xx.m_name; std::string placeholder = "_" + std::string(var_name); - ASR::ttype_t *type1 = ASRUtils::TYPE(ASR::make_CPtr_t(al, xx.base.base.loc)); - xx.m_type = type1; - if (var_name != "_lpython_return_variable") { + ASR::ttype_t *CPtr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, xx.base.base.loc)); + xx.m_type = CPtr_type; + if (xx.m_intent == ASR::intentType::Local) { symbolic_vars_to_free.insert(ASR::down_cast((ASR::asr_t*)&xx)); } if(xx.m_intent == ASR::intentType::In){ @@ -142,71 +371,6 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitoradd_symbol(s2c(al, placeholder), sym2); - - std::string new_name = "basic_new_stack"; - symbolic_dependencies.push_back(new_name); - if (!module_scope->get_symbol(new_name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable *fn_symtab = al.make_new(module_scope); - - Vec args; - { - args.reserve(al, 1); - ASR::symbol_t *arg = ASR::down_cast(ASR::make_Variable_t( - al, xx.base.base.loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, type1, nullptr, - ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, xx.base.base.loc, arg))); - } - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* new_subrout = ASRUtils::make_Function_t_util(al, xx.base.base.loc, - fn_symtab, s2c(al, new_name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, new_name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t *new_symbol = ASR::down_cast(new_subrout); - module_scope->add_symbol(new_name, new_symbol); - } - - new_name = "basic_free_stack"; - symbolic_dependencies.push_back(new_name); - if (!module_scope->get_symbol(new_name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable *fn_symtab = al.make_new(module_scope); - - Vec args; - { - args.reserve(al, 1); - ASR::symbol_t *arg = ASR::down_cast(ASR::make_Variable_t( - al, xx.base.base.loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, type1, nullptr, - ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, xx.base.base.loc, arg))); - } - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* new_subrout = ASRUtils::make_Function_t_util(al, xx.base.base.loc, - fn_symtab, s2c(al, new_name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, new_name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t *new_symbol = ASR::down_cast(new_subrout); - module_scope->add_symbol(new_name, new_symbol); - } - ASR::symbol_t* var_sym = current_scope->get_symbol(var_name); ASR::symbol_t* placeholder_sym = current_scope->get_symbol(placeholder); ASR::expr_t* target1 = ASRUtils::EXPR(ASR::make_Var_t(al, xx.base.base.loc, placeholder_sym)); @@ -220,29 +384,20 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorget_symbol("basic_new_stack"); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = xx.base.base.loc; - call_arg.m_value = target2; - call_args.push_back(al, call_arg); + CPtr_type, nullptr)); // defining the assignment statement ASR::stmt_t* stmt1 = ASRUtils::STMT(ASR::make_Assignment_t(al, xx.base.base.loc, target1, value1, nullptr)); ASR::stmt_t* stmt2 = ASRUtils::STMT(ASR::make_Assignment_t(al, xx.base.base.loc, target2, value2, nullptr)); ASR::stmt_t* stmt3 = ASRUtils::STMT(ASR::make_Assignment_t(al, xx.base.base.loc, target2, value3, nullptr)); - ASR::stmt_t* stmt4 = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, xx.base.base.loc, basic_new_stack_sym, - basic_new_stack_sym, call_args.p, call_args.n, nullptr)); + // statement 4 + ASR::stmt_t* stmt4 = basic_new_stack(x.base.base.loc, target2); pass_result.push_back(al, stmt1); pass_result.push_back(al, stmt2); @@ -259,170 +414,11 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorget_symbol(new_name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 3); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - ASR::symbol_t* arg3 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "z"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "z"), arg3); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg3))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* new_subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, new_name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, new_name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* new_symbol = ASR::down_cast(new_subrout); - module_scope->add_symbol(s2c(al, new_name), new_symbol); - } - - ASR::symbol_t* func_sym = module_scope->get_symbol(new_name); - Vec call_args; - call_args.reserve(al, 3); - ASR::call_arg_t call_arg1, call_arg2, call_arg3; - call_arg1.loc = loc; - call_arg1.m_value = value1; - call_arg2.loc = loc; - call_arg2.m_value = value2; - call_arg3.loc = loc; - call_arg3.m_value = value3; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - call_args.push_back(al, call_arg3); - - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, func_sym, - func_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); - } - - void perform_symbolic_unary_operation(Allocator &al, const Location &loc, SymbolTable* module_scope, - const std::string& new_name, ASR::expr_t* value1, ASR::expr_t* value2) { - symbolic_dependencies.push_back(new_name); - if (!module_scope->get_symbol(new_name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 2); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* new_subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, new_name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, new_name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* new_symbol = ASR::down_cast(new_subrout); - module_scope->add_symbol(s2c(al, new_name), new_symbol); - } - - ASR::symbol_t* func_sym = module_scope->get_symbol(new_name); - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = loc; - call_arg1.m_value = value1; - call_arg2.loc = loc; - call_arg2.m_value = value2; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, func_sym, - func_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); - } - - void perform_symbolic_constant_operation(Allocator &al, const Location &loc, SymbolTable* module_scope, - const std::string& new_name, ASR::expr_t* value) { - symbolic_dependencies.push_back(new_name); - if (!module_scope->get_symbol(new_name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* new_subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, new_name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, new_name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* new_symbol = ASR::down_cast(new_subrout); - module_scope->add_symbol(s2c(al, new_name), new_symbol); - } - - ASR::symbol_t* func_sym = module_scope->get_symbol(new_name); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = value; - call_args.push_back(al, call_arg); - - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, func_sym, - func_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); - } - ASR::expr_t* handle_argument(Allocator &al, const Location &loc, ASR::expr_t* arg) { if (ASR::is_a(*arg)) { return arg; - } else if (ASR::is_a(*arg)) { - this->visit_IntrinsicFunction(*ASR::down_cast(arg)); + } else if (ASR::is_a(*arg)) { + this->visit_IntrinsicFunction(*ASR::down_cast(arg)); } else if (ASR::is_a(*arg)) { this->visit_Cast(*ASR::down_cast(arg)); } else { @@ -432,144 +428,31 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorm_args[0]); - ASR::expr_t* value2 = handle_argument(al, loc, x->m_args[1]); - perform_symbolic_binary_operation(al, loc, module_scope, new_name, target, value1, value2); - } - - void process_unary_operator(Allocator &al, const Location &loc, ASR::IntrinsicScalarFunction_t* x, SymbolTable* module_scope, - const std::string& new_name, ASR::expr_t* target) { - ASR::expr_t* value1 = handle_argument(al, loc, x->m_args[0]); - perform_symbolic_unary_operation(al, loc, module_scope, new_name, target, value1); - } - - void process_constants(Allocator &al, const Location &loc, ASR::IntrinsicScalarFunction_t* /*x*/, SymbolTable* module_scope, - const std::string& new_name, ASR::expr_t* target) { - perform_symbolic_constant_operation(al, loc, module_scope, new_name, target); - } - - void process_intrinsic_function(Allocator &al, const Location &loc, ASR::IntrinsicScalarFunction_t* x, SymbolTable* module_scope, - ASR::expr_t* target){ + void process_intrinsic_function(const Location &loc, + ASR::IntrinsicElementalFunction_t* x, ASR::expr_t* target) { int64_t intrinsic_id = x->m_intrinsic_id; - switch (static_cast(intrinsic_id)) { - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicSymbol: { - std::string new_name = "symbol_set"; - symbolic_dependencies.push_back(new_name); - if (!module_scope->get_symbol(new_name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "s"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -2, nullptr)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "s"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* new_subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, new_name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, new_name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* new_symbol = ASR::down_cast(new_subrout); - module_scope->add_symbol(s2c(al, new_name), new_symbol); - } - - ASR::symbol_t* symbol_set_sym = module_scope->get_symbol(new_name); - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = loc; - call_arg1.m_value = target; - call_arg2.loc = loc; - call_arg2.m_value = x->m_args[0]; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, symbol_set_sym, - symbol_set_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicPi: { - process_constants(al, loc, x, module_scope, "basic_const_pi", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicE: { - process_constants(al, loc, x, module_scope, "basic_const_E", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicAdd: { - process_binary_operator(al, loc, x, module_scope, "basic_add", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicSub: { - process_binary_operator(al, loc, x, module_scope, "basic_sub", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicMul: { - process_binary_operator(al, loc, x, module_scope, "basic_mul", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicDiv: { - process_binary_operator(al, loc, x, module_scope, "basic_div", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicPow: { - process_binary_operator(al, loc, x, module_scope, "basic_pow", target); + switch (static_cast(intrinsic_id)) { + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicSymbol: { + pass_result.push_back(al, symbol_set(loc, target, x->m_args[0])); break; } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicDiff: { - process_binary_operator(al, loc, x, module_scope, "basic_diff", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicSin: { - process_unary_operator(al, loc, x, module_scope, "basic_sin", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicCos: { - process_unary_operator(al, loc, x, module_scope, "basic_cos", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicLog: { - process_unary_operator(al, loc, x, module_scope, "basic_log", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicExp: { - process_unary_operator(al, loc, x, module_scope, "basic_exp", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicAbs: { - process_unary_operator(al, loc, x, module_scope, "basic_abs", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicExpand: { - process_unary_operator(al, loc, x, module_scope, "basic_expand", target); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicGetArgument: { + BASIC_CONST(Pi, pi) + BASIC_CONST(E, E) + BASIC_BINOP(Add, add) + BASIC_BINOP(Sub, sub) + BASIC_BINOP(Mul, mul) + BASIC_BINOP(Div, div) + BASIC_BINOP(Pow, pow) + BASIC_BINOP(Diff, diff) + BASIC_UNARYOP(Sin, sin) + BASIC_UNARYOP(Cos, cos) + BASIC_UNARYOP(Log, log) + BASIC_UNARYOP(Exp, exp) + BASIC_UNARYOP(Abs, abs) + BASIC_UNARYOP(Expand, expand) + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicGetArgument: { // Define necessary function symbols ASR::expr_t* value1 = handle_argument(al, loc, x->m_args[0]); - ASR::symbol_t* basic_get_args_sym = declare_basic_get_args_function(al, loc, module_scope); - ASR::symbol_t* vecbasic_new_sym = declare_vecbasic_new_function(al, loc, module_scope); - ASR::symbol_t* vecbasic_get_sym = declare_vecbasic_get_function(al, loc, module_scope); - ASR::symbol_t* vecbasic_size_sym = declare_vecbasic_size_function(al, loc, module_scope); // Define necessary variables ASR::ttype_t* CPtr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)); @@ -582,38 +465,15 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor call_args1; - call_args1.reserve(al, 1); - ASR::expr_t* function_call1 = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - vecbasic_new_sym, vecbasic_new_sym, call_args1.p, call_args1.n, - ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), nullptr, nullptr)); + ASR::expr_t* function_call1 = vecbasic_new(loc); ASR::stmt_t* stmt1 = ASRUtils::STMT(ASR::make_Assignment_t(al, loc, args, function_call1, nullptr)); pass_result.push_back(al, stmt1); // Statement 2 - Vec call_args2; - call_args2.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = loc; - call_arg1.m_value = value1; - call_arg2.loc = loc; - call_arg2.m_value = args; - call_args2.push_back(al, call_arg1); - call_args2.push_back(al, call_arg2); - ASR::stmt_t* stmt2 = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, basic_get_args_sym, - basic_get_args_sym, call_args2.p, call_args2.n, nullptr)); - pass_result.push_back(al, stmt2); + pass_result.push_back(al, basic_get_args(loc, value1, args)); // Statement 3 - Vec call_args3; - call_args3.reserve(al, 1); - ASR::call_arg_t call_arg3; - call_arg3.loc = loc; - call_arg3.m_value = args; - call_args3.push_back(al, call_arg3); - ASR::expr_t* function_call2 = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - vecbasic_size_sym, vecbasic_size_sym, call_args3.p, call_args3.n, - ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), nullptr, nullptr)); + ASR::expr_t* function_call2 = vecbasic_size(loc, args); ASR::expr_t* test = ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, function_call2, ASR::cmpopType::Gt, x->m_args[1], ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr)); std::string error_str = "tuple index out of range"; @@ -624,21 +484,7 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor call_args4; - call_args4.reserve(al, 3); - ASR::call_arg_t call_arg4, call_arg5, call_arg6; - call_arg4.loc = loc; - call_arg4.m_value = args; - call_arg5.loc = loc; - call_arg5.m_value = x->m_args[1]; - call_arg6.loc = loc; - call_arg6.m_value = target; - call_args4.push_back(al, call_arg4); - call_args4.push_back(al, call_arg5); - call_args4.push_back(al, call_arg6); - ASR::stmt_t* stmt4 = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, loc, vecbasic_get_sym, - vecbasic_get_sym, call_args4.p, call_args4.n, nullptr)); - pass_result.push_back(al, stmt4); + pass_result.push_back(al, vecbasic_get(loc, args, x->m_args[1], target)); break; } default: { @@ -649,564 +495,23 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorget_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 2); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_basic_str_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "basic_str"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -2, nullptr)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_integer_set_si_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "integer_set_si"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 2); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 8)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_basic_get_type_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "basic_get_type"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_basic_get_args_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "basic_get_args"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 2); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_vecbasic_new_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "vecbasic_new"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE((ASR::make_CPtr_t(al, loc))), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_vecbasic_get_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "vecbasic_get"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 3); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg1); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg1))); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE((ASR::make_Integer_t(al, loc, 4))), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - ASR::symbol_t* arg3 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "z"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "z"), arg3); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg3))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - nullptr, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_vecbasic_size_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "vecbasic_size"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_basic_eq_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "basic_eq"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - ASR::symbol_t* arg3 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg3); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg3))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::symbol_t* declare_basic_neq_function(Allocator& al, const Location& loc, SymbolTable* module_scope) { - std::string name = "basic_neq"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - ASR::symbol_t* arg3 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg3); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg3))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - return module_scope->get_symbol(name); - } - - ASR::expr_t* process_attributes(Allocator &al, const Location &loc, ASR::expr_t* expr, - SymbolTable* module_scope) { - if (ASR::is_a(*expr)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(expr); + ASR::expr_t* process_attributes(const Location &loc, ASR::expr_t* expr) { + if (ASR::is_a(*expr)) { + ASRUtils::ASRBuilder b(al, loc); + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(expr); int64_t intrinsic_id = intrinsic_func->m_intrinsic_id; - switch (static_cast(intrinsic_id)) { - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicHasSymbolQ: { - std::string name = "basic_has_symbol"; - symbolic_dependencies.push_back(name); - if (!module_scope->get_symbol(name)) { - std::string header = "symengine/cwrapper.h"; - SymbolTable* fn_symtab = al.make_new(module_scope); - - Vec args; - args.reserve(al, 1); - ASR::symbol_t* arg1 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "_lpython_return_variable"), nullptr, 0, ASR::intentType::ReturnVar, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, false)); - fn_symtab->add_symbol(s2c(al, "_lpython_return_variable"), arg1); - ASR::symbol_t* arg2 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "x"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "x"), arg2); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg2))); - ASR::symbol_t* arg3 = ASR::down_cast(ASR::make_Variable_t( - al, loc, fn_symtab, s2c(al, "y"), nullptr, 0, ASR::intentType::In, - nullptr, nullptr, ASR::storage_typeType::Default, ASRUtils::TYPE(ASR::make_CPtr_t(al, loc)), - nullptr, ASR::abiType::BindC, ASR::Public, ASR::presenceType::Required, true)); - fn_symtab->add_symbol(s2c(al, "y"), arg3); - args.push_back(al, ASRUtils::EXPR(ASR::make_Var_t(al, loc, arg3))); - - Vec body; - body.reserve(al, 1); - - Vec dep; - dep.reserve(al, 1); - - ASR::expr_t* return_var = ASRUtils::EXPR(ASR::make_Var_t(al, loc, fn_symtab->get_symbol("_lpython_return_variable"))); - ASR::asr_t* subrout = ASRUtils::make_Function_t_util(al, loc, - fn_symtab, s2c(al, name), dep.p, dep.n, args.p, args.n, body.p, body.n, - return_var, ASR::abiType::BindC, ASR::accessType::Public, - ASR::deftypeType::Interface, s2c(al, name), false, false, false, - false, false, nullptr, 0, false, false, false, s2c(al, header)); - ASR::symbol_t* symbol = ASR::down_cast(subrout); - module_scope->add_symbol(s2c(al, name), symbol); - } - - ASR::symbol_t* basic_has_symbol = module_scope->get_symbol(name); - ASR::expr_t* value1 = handle_argument(al, loc, intrinsic_func->m_args[0]); - ASR::expr_t* value2 = handle_argument(al, loc, intrinsic_func->m_args[1]); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = loc; - call_arg1.m_value = value1; - call_args.push_back(al, call_arg1); - call_arg2.loc = loc; - call_arg2.m_value = value2; - call_args.push_back(al, call_arg2); - return ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_has_symbol, basic_has_symbol, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr, nullptr)); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicAddQ: { - ASR::symbol_t* basic_get_type_sym = declare_basic_get_type_function(al, loc, module_scope); - ASR::expr_t* value1 = handle_argument(al, loc, intrinsic_func->m_args[0]); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = value1; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_get_type_sym, basic_get_type_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), nullptr, nullptr)); - // Using 16 as the right value of the IntegerCompare node as it represents SYMENGINE_ADD through SYMENGINE_ENUM - return ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, function_call, ASR::cmpopType::Eq, - ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 16, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))), - ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr)); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicMulQ: { - ASR::symbol_t* basic_get_type_sym = declare_basic_get_type_function(al, loc, module_scope); - ASR::expr_t* value1 = handle_argument(al, loc, intrinsic_func->m_args[0]); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = value1; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_get_type_sym, basic_get_type_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), nullptr, nullptr)); - // Using 15 as the right value of the IntegerCompare node as it represents SYMENGINE_MUL through SYMENGINE_ENUM - return ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, function_call, ASR::cmpopType::Eq, - ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 15, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))), - ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr)); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicPowQ: { - ASR::symbol_t* basic_get_type_sym = declare_basic_get_type_function(al, loc, module_scope); - ASR::expr_t* value1 = handle_argument(al, loc, intrinsic_func->m_args[0]); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = value1; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_get_type_sym, basic_get_type_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), nullptr, nullptr)); - // Using 17 as the right value of the IntegerCompare node as it represents SYMENGINE_POW through SYMENGINE_ENUM - return ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, function_call, ASR::cmpopType::Eq, - ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 17, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))), - ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr)); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicLogQ: { - ASR::symbol_t* basic_get_type_sym = declare_basic_get_type_function(al, loc, module_scope); - ASR::expr_t* value1 = handle_argument(al, loc, intrinsic_func->m_args[0]); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = value1; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_get_type_sym, basic_get_type_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), nullptr, nullptr)); - // Using 29 as the right value of the IntegerCompare node as it represents SYMENGINE_LOG through SYMENGINE_ENUM - return ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, function_call, ASR::cmpopType::Eq, - ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 29, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))), - ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr)); - break; - } - case LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicSinQ: { - ASR::symbol_t* basic_get_type_sym = declare_basic_get_type_function(al, loc, module_scope); - ASR::expr_t* value1 = handle_argument(al, loc, intrinsic_func->m_args[0]); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = value1; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_get_type_sym, basic_get_type_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)), nullptr, nullptr)); - // Using 35 as the right value of the IntegerCompare node as it represents SYMENGINE_SIN through SYMENGINE_ENUM - return ASRUtils::EXPR(ASR::make_IntegerCompare_t(al, loc, function_call, ASR::cmpopType::Eq, - ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, loc, 35, ASRUtils::TYPE(ASR::make_Integer_t(al, loc, 4)))), - ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)), nullptr)); - break; + switch (static_cast(intrinsic_id)) { + case LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicHasSymbolQ: { + return basic_has_symbol(loc, intrinsic_func->m_args[0], + intrinsic_func->m_args[1]); } + // (sym_name, n) where n = 16, 15, ... as the right value of the + // IntegerCompare node as it represents SYMENGINE_ADD through SYMENGINE_ENUM + BASIC_ATTR(AddQ, 16) + BASIC_ATTR(MulQ, 15) + BASIC_ATTR(PowQ, 17) + BASIC_ATTR(LogQ, 29) + BASIC_ATTR(SinQ, 35) default: { throw LCompilersException("IntrinsicFunction: `" + ASRUtils::get_intrinsic_name(intrinsic_id) @@ -1218,34 +523,23 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorparent; if (ASR::is_a(*x.m_value) && ASR::is_a(*ASRUtils::expr_type(x.m_value))) { ASR::symbol_t *v = ASR::down_cast(x.m_value)->m_v; - if (symbolic_vars_to_free.find(v) == symbolic_vars_to_free.end()) return; - ASR::symbol_t* basic_assign_sym = declare_basic_assign_function(al, x.base.base.loc, module_scope); + if ((symbolic_vars_to_free.find(v) == symbolic_vars_to_free.end()) && + (symbolic_vars_to_omit.find(v) == symbolic_vars_to_omit.end())) return; ASR::symbol_t* var_sym = ASR::down_cast(x.m_value)->m_v; - ASR::expr_t* target = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, var_sym)); - - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = x.m_target; - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = target; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, x.base.base.loc, basic_assign_sym, - basic_assign_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); - } else if (ASR::is_a(*x.m_value)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(x.m_value); + pass_result.push_back(al, basic_assign(x.base.base.loc, x.m_target, + ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, var_sym)))); + } else if (ASR::is_a(*x.m_value)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(x.m_value); if (intrinsic_func->m_type->type == ASR::ttypeType::SymbolicExpression) { - process_intrinsic_function(al, x.base.base.loc, intrinsic_func, module_scope, x.m_target); + process_intrinsic_function(x.base.base.loc, intrinsic_func, x.m_target); } else if (intrinsic_func->m_type->type == ASR::ttypeType::Logical) { - ASR::expr_t* function_call = process_attributes(al, x.base.base.loc, x.m_value, module_scope); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, x.m_target, function_call, nullptr)); - pass_result.push_back(al, stmt); + if (is_logical_intrinsic_symbolic(x.m_value)) { + ASR::expr_t* function_call = process_attributes(x.base.base.loc, x.m_value); + ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, x.m_target, function_call, nullptr)); + pass_result.push_back(al, stmt); + } } } else if (ASR::is_a(*x.m_value)) { ASR::Cast_t* cast_t = ASR::down_cast(x.m_value); @@ -1253,27 +547,15 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorm_arg; ASR::expr_t* cast_value = cast_t->m_value; if (ASR::is_a(*cast_arg)) { - ASR::symbol_t* integer_set_sym = declare_integer_set_si_function(al, x.base.base.loc, module_scope); ASR::ttype_t* cast_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x.base.base.loc, 8)); ASR::expr_t* value = ASRUtils::EXPR(ASR::make_Cast_t(al, x.base.base.loc, cast_arg, (ASR::cast_kindType)ASR::cast_kindType::IntegerToInteger, cast_type, nullptr)); - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = x.m_target; - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = value; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, x.base.base.loc, integer_set_sym, - integer_set_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); - } else if (ASR::is_a(*cast_value)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(cast_value); + pass_result.push_back(al, integer_set_si(x.base.base.loc, x.m_target, value)); + } else if (ASR::is_a(*cast_value)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(cast_value); int64_t intrinsic_id = intrinsic_func->m_intrinsic_id; - if (static_cast(intrinsic_id) == - LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicInteger) { + if (static_cast(intrinsic_id) == + LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicInteger) { int const_value = 0; if (ASR::is_a(*cast_arg)){ ASR::IntegerConstant_t* const_int = ASR::down_cast(cast_arg); @@ -1285,24 +567,11 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorm_n; } - ASR::symbol_t* integer_set_sym = declare_integer_set_si_function(al, x.base.base.loc, module_scope); ASR::ttype_t* cast_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x.base.base.loc, 8)); ASR::expr_t* value = ASRUtils::EXPR(ASR::make_Cast_t(al, x.base.base.loc, cast_arg, (ASR::cast_kindType)ASR::cast_kindType::IntegerToInteger, cast_type, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, const_value, cast_type)))); - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = x.m_target; - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = value; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, x.base.base.loc, integer_set_sym, - integer_set_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); + pass_result.push_back(al, integer_set_si(x.base.base.loc, x.m_target, value)); } } } @@ -1310,67 +579,113 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor(x.m_value); if (list_constant->m_type->type == ASR::ttypeType::List) { ASR::List_t* list = ASR::down_cast(list_constant->m_type); - if (list->m_type->type == ASR::ttypeType::SymbolicExpression){ - Vec temp_list; - temp_list.reserve(al, list_constant->n_args + 1); - for (size_t i = 0; i < list_constant->n_args; ++i) { - ASR::expr_t* value = handle_argument(al, x.base.base.loc, list_constant->m_args[i]); - temp_list.push_back(al, value); + if (list->m_type->type == ASR::ttypeType::SymbolicExpression){ + if(ASR::is_a(*x.m_target)) { + ASR::symbol_t *v = ASR::down_cast(x.m_target)->m_v; + if (ASR::is_a(*v)) { + // Step1: Add the placeholder for the list variable to the scope + ASRUtils::ASRBuilder b(al, x.base.base.loc); + ASR::ttype_t* CPtr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, x.base.base.loc)); + ASR::ttype_t* list_type = ASRUtils::TYPE(ASR::make_List_t(al, x.base.base.loc, CPtr_type)); + ASR::Variable_t *list_variable = ASR::down_cast(v); + std::string list_name = list_variable->m_name; + std::string placeholder = "_" + std::string(list_name); + + ASR::symbol_t* placeholder_sym = ASR::down_cast( + ASR::make_Variable_t(al, list_variable->base.base.loc, current_scope, + s2c(al, placeholder), nullptr, 0, + list_variable->m_intent, nullptr, + nullptr, list_variable->m_storage, + list_type, nullptr, list_variable->m_abi, + list_variable->m_access, list_variable->m_presence, + list_variable->m_value_attr)); + + current_scope->add_symbol(s2c(al, placeholder), placeholder_sym); + ASR::expr_t* placeholder_target = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, placeholder_sym)); + + Vec temp_list1, temp_list2; + temp_list1.reserve(al, list_constant->n_args + 1); + temp_list2.reserve(al, list_constant->n_args + 1); + + for (size_t i = 0; i < list_constant->n_args; ++i) { + ASR::expr_t* value = handle_argument(al, x.base.base.loc, list_constant->m_args[i]); + temp_list1.push_back(al, value); + } + + ASR::expr_t* temp_list_const1 = ASRUtils::EXPR(ASR::make_ListConstant_t(al, x.base.base.loc, temp_list1.p, + temp_list1.size(), list_type)); + ASR::stmt_t* stmt1 = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, placeholder_target, temp_list_const1, nullptr)); + pass_result.push_back(al, stmt1); + + // Step2: Add the empty list variable + ASR::expr_t* temp_list_const2 = ASRUtils::EXPR(ASR::make_ListConstant_t(al, x.base.base.loc, temp_list2.p, + temp_list2.size(), list_type)); + ASR::stmt_t* stmt2 = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, x.m_target, temp_list_const2, nullptr)); + pass_result.push_back(al, stmt2); + + // Step3: Add the list index to the function scope + std::string symbolic_list_index = current_scope->get_unique_name("symbolic_list_index"); + ASR::ttype_t* int32_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x.base.base.loc, 4)); + ASR::symbol_t* index_sym = ASR::down_cast( + ASR::make_Variable_t(al, x.base.base.loc, current_scope, s2c(al, symbolic_list_index), + nullptr, 0, ASR::intentType::Local, nullptr, nullptr, ASR::storage_typeType::Default, + int32_type, nullptr, ASR::abiType::Source, ASR::Public, ASR::presenceType::Required, false)); + current_scope->add_symbol(symbolic_list_index, index_sym); + ASR::expr_t* index = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, index_sym)); + ASR::stmt_t* stmt3 = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, index, + ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, 0, int32_type)), nullptr)); + pass_result.push_back(al, stmt3); + + // Step4: Add the DoLoop for appending elements into the list + std::string block_name = current_scope->get_unique_name("block"); + SymbolTable* block_symtab = al.make_new(current_scope); + char *tmp_var_name = s2c(al, "tmp"); + ASR::expr_t* tmp_var = b.Variable(block_symtab, tmp_var_name, CPtr_type, + ASR::intentType::Local, ASR::abiType::Source, false); + Vec block_body; block_body.reserve(al, 1); + ASR::stmt_t* block_stmt1 = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, tmp_var, + basic_new_heap(x.base.base.loc), nullptr)); + block_body.push_back(al, block_stmt1); + ASR::stmt_t* block_stmt2 = ASRUtils::STMT(ASR::make_ListAppend_t(al, x.base.base.loc, x.m_target, tmp_var)); + block_body.push_back(al, block_stmt2); + block_body.push_back(al, basic_assign(x.base.base.loc, ASRUtils::EXPR(ASR::make_ListItem_t(al, + x.base.base.loc, x.m_target, index, CPtr_type, nullptr)), ASRUtils::EXPR(ASR::make_ListItem_t(al, + x.base.base.loc, placeholder_target, index, CPtr_type, nullptr)))); + ASR::symbol_t* block = ASR::down_cast(ASR::make_Block_t(al, x.base.base.loc, + block_symtab, s2c(al, block_name), block_body.p, block_body.n)); + current_scope->add_symbol(block_name, block); + ASR::stmt_t* block_call = ASRUtils::STMT(ASR::make_BlockCall_t( + al, x.base.base.loc, -1, block)); + std::vector do_loop_body; + do_loop_body.push_back(block_call); + ASR::stmt_t* stmt4 = b.DoLoop(index, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, 0, int32_type)), + ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, x.base.base.loc, + ASRUtils::EXPR(ASR::make_ListLen_t(al, x.base.base.loc, placeholder_target, int32_type, nullptr)), ASR::binopType::Sub, + ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, 1, int32_type)), int32_type, nullptr)), + do_loop_body, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, 1, int32_type))); + pass_result.push_back(al, stmt4); + } } - - ASR::ttype_t* type = ASRUtils::TYPE(ASR::make_CPtr_t(al, x.base.base.loc)); - ASR::ttype_t* list_type = ASRUtils::TYPE(ASR::make_List_t(al, x.base.base.loc, type)); - ASR::expr_t* temp_list_const = ASRUtils::EXPR(ASR::make_ListConstant_t(al, x.base.base.loc, temp_list.p, - temp_list.size(), list_type)); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, x.m_target, temp_list_const, nullptr)); - pass_result.push_back(al, stmt); } } } else if (ASR::is_a(*x.m_value)) { ASR::ListItem_t* list_item = ASR::down_cast(x.m_value); if (list_item->m_type->type == ASR::ttypeType::SymbolicExpression) { - ASR::ttype_t *CPtr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, x.base.base.loc)); - ASR::symbol_t* basic_assign_sym = declare_basic_assign_function(al, x.base.base.loc, module_scope); - - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = x.m_target; - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = ASRUtils::EXPR(ASR::make_ListItem_t(al, x.base.base.loc, list_item->m_a, - list_item->m_pos, CPtr_type, nullptr)); - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, x.base.base.loc, basic_assign_sym, - basic_assign_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); + ASR::expr_t *value = ASRUtils::EXPR(ASR::make_ListItem_t(al, + x.base.base.loc, list_item->m_a, list_item->m_pos, + ASRUtils::TYPE(ASR::make_CPtr_t(al, x.base.base.loc)), nullptr)); + pass_result.push_back(al, basic_assign(x.base.base.loc, x.m_target, value)); } } else if (ASR::is_a(*x.m_value)) { ASR::SymbolicCompare_t *s = ASR::down_cast(x.m_value); if (s->m_op == ASR::cmpopType::Eq || s->m_op == ASR::cmpopType::NotEq) { - ASR::symbol_t* sym = nullptr; + ASR::expr_t* function_call = nullptr; if (s->m_op == ASR::cmpopType::Eq) { - sym = declare_basic_eq_function(al, x.base.base.loc, module_scope); + function_call = basic_compare(x.base.base.loc, "basic_eq", s->m_left, s->m_right); } else { - sym = declare_basic_neq_function(al, x.base.base.loc, module_scope); + function_call = basic_compare(x.base.base.loc, "basic_neq", s->m_left, s->m_right); } - ASR::expr_t* value1 = handle_argument(al, x.base.base.loc, s->m_left); - ASR::expr_t* value2 = handle_argument(al, x.base.base.loc, s->m_right); - - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = value1; - call_args.push_back(al, call_arg1); - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = value2; - call_args.push_back(al, call_arg2); - - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - sym, sym, call_args.p, call_args.n, ASRUtils::TYPE(ASR::make_Logical_t(al, x.base.base.loc, 4)), nullptr, nullptr)); ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_Assignment_t(al, x.base.base.loc, x.m_target, function_call, nullptr)); pass_result.push_back(al, stmt); } @@ -1381,25 +696,49 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor(x); transform_stmts(xx.m_body, xx.n_body); transform_stmts(xx.m_orelse, xx.n_orelse); - SymbolTable* module_scope = current_scope->parent; - if (ASR::is_a(*xx.m_test)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(xx.m_test); + if (ASR::is_a(*xx.m_test)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(xx.m_test); if (intrinsic_func->m_type->type == ASR::ttypeType::Logical) { - ASR::expr_t* function_call = process_attributes(al, xx.base.base.loc, xx.m_test, module_scope); - xx.m_test = function_call; + if (is_logical_intrinsic_symbolic(xx.m_test)) { + ASR::expr_t* function_call = process_attributes(xx.base.base.loc, xx.m_test); + xx.m_test = function_call; + } } + } else if (ASR::is_a(*xx.m_test)) { + ASR::LogicalNot_t* logical_not = ASR::down_cast(xx.m_test); + if (ASR::is_a(*logical_not->m_arg)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(logical_not->m_arg); + if (intrinsic_func->m_type->type == ASR::ttypeType::Logical) { + if (is_logical_intrinsic_symbolic(logical_not->m_arg)) { + ASR::expr_t* function_call = process_attributes(xx.base.base.loc, logical_not->m_arg); + ASR::expr_t* new_logical_not = ASRUtils::EXPR(ASR::make_LogicalNot_t(al, xx.base.base.loc, function_call, + logical_not->m_type, logical_not->m_value)); + xx.m_test = new_logical_not; + } + } + } + } else if (ASR::is_a(*xx.m_test)) { + ASR::SymbolicCompare_t *s = ASR::down_cast(xx.m_test); + ASR::expr_t* function_call = nullptr; + if (s->m_op == ASR::cmpopType::Eq) { + function_call = basic_compare(xx.base.base.loc, "basic_eq", s->m_left, s->m_right); + } else { + function_call = basic_compare(xx.base.base.loc, "basic_neq", s->m_left, s->m_right); + } + ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_If_t(al, xx.base.base.loc, function_call, + xx.m_body, xx.n_body, xx.m_orelse, xx.n_orelse)); + pass_result.push_back(al, stmt); } } void visit_SubroutineCall(const ASR::SubroutineCall_t &x) { - SymbolTable* module_scope = current_scope->parent; Vec call_args; call_args.reserve(al, 1); for (size_t i=0; i(*val) && ASR::is_a(*ASRUtils::expr_type(val))) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(val); + if (val && ASR::is_a(*val) && ASR::is_a(*ASRUtils::expr_type(val))) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(val); ASR::ttype_t *type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, x.base.base.loc)); std::string symengine_var = symengine_stack.push(); ASR::symbol_t *arg = ASR::down_cast(ASR::make_Variable_t( @@ -1415,7 +754,7 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor print_tmp; - SymbolTable* module_scope = current_scope->parent; for (size_t i=0; i(*val) && ASR::is_a(*ASRUtils::expr_type(val))) { ASR::symbol_t *v = ASR::down_cast(val)->m_v; - if (symbolic_vars_to_free.find(v) == symbolic_vars_to_free.end()) return; - ASR::symbol_t* basic_str_sym = declare_basic_str_function(al, x.base.base.loc, module_scope); - - // Extract the symbol from value (Var) - ASR::symbol_t* var_sym = ASR::down_cast(val)->m_v; - ASR::expr_t* target = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, var_sym)); - - // Now create the FunctionCall node for basic_str - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = x.base.base.loc; - call_arg.m_value = target; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - basic_str_sym, basic_str_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Character_t(al, x.base.base.loc, 1, -2, nullptr)), nullptr, nullptr)); - print_tmp.push_back(function_call); - } else if (ASR::is_a(*val)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(val); + if ((symbolic_vars_to_free.find(v) == symbolic_vars_to_free.end()) && + (symbolic_vars_to_omit.find(v) == symbolic_vars_to_omit.end())) return; + print_tmp.push_back(basic_str(x.base.base.loc, val)); + } else if (ASR::is_a(*val)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(val); if (ASR::is_a(*ASRUtils::expr_type(val))) { ASR::ttype_t *type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, x.base.base.loc)); std::string symengine_var = symengine_stack.push(); @@ -1484,25 +807,15 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = x.base.base.loc; - call_arg.m_value = target; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - basic_str_sym, basic_str_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Character_t(al, x.base.base.loc, 1, -2, nullptr)), nullptr, nullptr)); - print_tmp.push_back(function_call); + print_tmp.push_back(basic_str(x.base.base.loc, target)); } else if (ASR::is_a(*ASRUtils::expr_type(val))) { - ASR::expr_t* function_call = process_attributes(al, x.base.base.loc, val, module_scope); - print_tmp.push_back(function_call); - } else { - print_tmp.push_back(x.m_values[i]); + if (is_logical_intrinsic_symbolic(val)) { + ASR::expr_t* function_call = process_attributes(x.base.base.loc, val); + print_tmp.push_back(function_call); + } } } else if (ASR::is_a(*val)) { ASR::Cast_t* cast_t = ASR::down_cast(val); @@ -1512,64 +825,27 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = x.base.base.loc; - call_arg.m_value = target; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - basic_str_sym, basic_str_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Character_t(al, x.base.base.loc, 1, -2, nullptr)), nullptr, nullptr)); - print_tmp.push_back(function_call); + print_tmp.push_back(basic_str(x.base.base.loc, target)); } else if (ASR::is_a(*val)) { ASR::SymbolicCompare_t *s = ASR::down_cast(val); if (s->m_op == ASR::cmpopType::Eq || s->m_op == ASR::cmpopType::NotEq) { - ASR::symbol_t* sym = nullptr; + ASR::expr_t* function_call = nullptr; if (s->m_op == ASR::cmpopType::Eq) { - sym = declare_basic_eq_function(al, x.base.base.loc, module_scope); + function_call = basic_compare(x.base.base.loc, "basic_eq", s->m_left, s->m_right); } else { - sym = declare_basic_neq_function(al, x.base.base.loc, module_scope); + function_call = basic_compare(x.base.base.loc, "basic_neq", s->m_left, s->m_right); } - ASR::expr_t* value1 = handle_argument(al, x.base.base.loc, s->m_left); - ASR::expr_t* value2 = handle_argument(al, x.base.base.loc, s->m_right); - - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = value1; - call_args.push_back(al, call_arg1); - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = value2; - call_args.push_back(al, call_arg2); - - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - sym, sym, call_args.p, call_args.n, ASRUtils::TYPE(ASR::make_Logical_t(al, x.base.base.loc, 4)), nullptr, nullptr)); print_tmp.push_back(function_call); - } else { - print_tmp.push_back(x.m_values[i]); } } else if (ASR::is_a(*val)) { ASR::ListItem_t* list_item = ASR::down_cast(val); if (list_item->m_type->type == ASR::ttypeType::SymbolicExpression) { - ASR::ttype_t *CPtr_type = ASRUtils::TYPE(ASR::make_CPtr_t(al, x.base.base.loc)); - ASR::symbol_t* basic_str_sym = declare_basic_str_function(al, x.base.base.loc, module_scope); - - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = x.base.base.loc; - call_arg.m_value = ASRUtils::EXPR(ASR::make_ListItem_t(al, x.base.base.loc, list_item->m_a, - list_item->m_pos, CPtr_type, nullptr)); - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - basic_str_sym, basic_str_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Character_t(al, x.base.base.loc, 1, -2, nullptr)), nullptr, nullptr)); - print_tmp.push_back(function_call); + ASR::expr_t *value = ASRUtils::EXPR(ASR::make_ListItem_t(al, + x.base.base.loc, list_item->m_a, list_item->m_pos, + ASRUtils::TYPE(ASR::make_CPtr_t(al, x.base.base.loc)), nullptr)); + print_tmp.push_back(basic_str(x.base.base.loc, value)); } else { - print_tmp.push_back(x.m_values[i]); + print_tmp.push_back(val); } } else { print_tmp.push_back(x.m_values[i]); @@ -1589,10 +865,8 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitortype == ASR::ttypeType::SymbolicExpression) { - SymbolTable* module_scope = current_scope->parent; - ASR::ttype_t *type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, x.base.base.loc)); std::string symengine_var = symengine_stack.push(); ASR::symbol_t *arg = ASR::down_cast(ASR::make_Variable_t( @@ -1607,15 +881,14 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor(x); + ASR::IntrinsicElementalFunction_t &xx = const_cast(x); ASR::expr_t* target = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, arg)); - process_intrinsic_function(al, x.base.base.loc, &xx, module_scope, target); + process_intrinsic_function(x.base.base.loc, &xx, target); } } void visit_Cast(const ASR::Cast_t &x) { if(x.m_kind != ASR::cast_kindType::IntegerToSymbolicExpression) return; - SymbolTable* module_scope = current_scope->parent; ASR::ttype_t *type = ASRUtils::TYPE(ASR::make_SymbolicExpression_t(al, x.base.base.loc)); std::string symengine_var = symengine_stack.push(); @@ -1634,11 +907,11 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor(*cast_value)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(cast_value); + if (ASR::is_a(*cast_value)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(cast_value); int64_t intrinsic_id = intrinsic_func->m_intrinsic_id; - if (static_cast(intrinsic_id) == - LCompilers::ASRUtils::IntrinsicScalarFunctions::SymbolicInteger) { + if (static_cast(intrinsic_id) == + LCompilers::ASRUtils::IntrinsicElementalFunctions::SymbolicInteger) { int const_value = 0; if (ASR::is_a(*cast_arg)){ ASR::IntegerConstant_t* const_int = ASR::down_cast(cast_arg); @@ -1650,118 +923,83 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitorm_n; } - ASR::symbol_t* integer_set_sym = declare_integer_set_si_function(al, x.base.base.loc, module_scope); ASR::ttype_t* cast_type = ASRUtils::TYPE(ASR::make_Integer_t(al, x.base.base.loc, 8)); ASR::expr_t* value = ASRUtils::EXPR(ASR::make_Cast_t(al, x.base.base.loc, cast_arg, (ASR::cast_kindType)ASR::cast_kindType::IntegerToInteger, cast_type, ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, const_value, cast_type)))); - Vec call_args; - call_args.reserve(al, 2); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = target; - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = value; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, x.base.base.loc, integer_set_sym, - integer_set_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); + pass_result.push_back(al, integer_set_si(x.base.base.loc, target, value)); } } } - ASR::expr_t* process_with_basic_str(Allocator &al, const Location &loc, const ASR::expr_t* expr, - ASR::symbol_t* basic_str_sym) { + ASR::expr_t* process_with_basic_str(const Location &loc, const ASR::expr_t *expr) { ASR::symbol_t *var_sym = nullptr; if (ASR::is_a(*expr)) { var_sym = ASR::down_cast(expr)->m_v; - } else if (ASR::is_a(*expr)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(expr); + } else if (ASR::is_a(*expr)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(expr); this->visit_IntrinsicFunction(*intrinsic_func); var_sym = current_scope->get_symbol(symengine_stack.pop()); } else if (ASR::is_a(*expr)) { ASR::Cast_t* cast_t = ASR::down_cast(expr); this->visit_Cast(*cast_t); var_sym = current_scope->get_symbol(symengine_stack.pop()); + } else { + LCOMPILERS_ASSERT(false); } ASR::expr_t* target = ASRUtils::EXPR(ASR::make_Var_t(al, loc, var_sym)); - // Now create the FunctionCall node for basic_str - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = loc; - call_arg.m_value = target; - call_args.push_back(al, call_arg); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, loc, - basic_str_sym, basic_str_sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Character_t(al, loc, 1, -2, nullptr)), nullptr, nullptr)); - return function_call; + // Now create the FunctionCall node for basic_str and return + return basic_str(loc, target); } void visit_Assert(const ASR::Assert_t &x) { - SymbolTable* module_scope = current_scope->parent; ASR::expr_t* left_tmp = nullptr; ASR::expr_t* right_tmp = nullptr; if (ASR::is_a(*x.m_test)) { ASR::LogicalCompare_t *l = ASR::down_cast(x.m_test); + if (is_logical_intrinsic_symbolic(l->m_left) && is_logical_intrinsic_symbolic(l->m_right)) { + left_tmp = process_attributes(x.base.base.loc, l->m_left); + right_tmp = process_attributes(x.base.base.loc, l->m_right); + ASR::expr_t* test = ASRUtils::EXPR(ASR::make_LogicalCompare_t(al, x.base.base.loc, left_tmp, + l->m_op, right_tmp, l->m_type, l->m_value)); - left_tmp = process_attributes(al, x.base.base.loc, l->m_left, module_scope); - right_tmp = process_attributes(al, x.base.base.loc, l->m_right, module_scope); - ASR::expr_t* test = ASRUtils::EXPR(ASR::make_LogicalCompare_t(al, x.base.base.loc, left_tmp, - l->m_op, right_tmp, l->m_type, l->m_value)); - - ASR::stmt_t *assert_stmt = ASRUtils::STMT(ASR::make_Assert_t(al, x.base.base.loc, test, x.m_msg)); - pass_result.push_back(al, assert_stmt); + ASR::stmt_t *assert_stmt = ASRUtils::STMT(ASR::make_Assert_t(al, x.base.base.loc, test, x.m_msg)); + pass_result.push_back(al, assert_stmt); + } } else if (ASR::is_a(*x.m_test)) { ASR::SymbolicCompare_t* s = ASR::down_cast(x.m_test); if (s->m_op == ASR::cmpopType::Eq || s->m_op == ASR::cmpopType::NotEq) { - ASR::symbol_t* sym = nullptr; + ASR::expr_t* function_call = nullptr; if (s->m_op == ASR::cmpopType::Eq) { - sym = declare_basic_eq_function(al, x.base.base.loc, module_scope); + function_call = basic_compare(x.base.base.loc, "basic_eq", s->m_left, s->m_right); } else { - sym = declare_basic_neq_function(al, x.base.base.loc, module_scope); + function_call = basic_compare(x.base.base.loc, "basic_neq", s->m_left, s->m_right); } - ASR::expr_t* value1 = handle_argument(al, x.base.base.loc, s->m_left); - ASR::expr_t* value2 = handle_argument(al, x.base.base.loc, s->m_right); - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg1, call_arg2; - call_arg1.loc = x.base.base.loc; - call_arg1.m_value = value1; - call_arg2.loc = x.base.base.loc; - call_arg2.m_value = value2; - call_args.push_back(al, call_arg1); - call_args.push_back(al, call_arg2); - ASR::expr_t* function_call = ASRUtils::EXPR(ASRUtils::make_FunctionCall_t_util(al, x.base.base.loc, - sym, sym, call_args.p, call_args.n, - ASRUtils::TYPE(ASR::make_Logical_t(al, x.base.base.loc, 4)), nullptr, nullptr)); - ASR::stmt_t *assert_stmt = ASRUtils::STMT(ASR::make_Assert_t(al, x.base.base.loc, function_call, x.m_msg)); pass_result.push_back(al, assert_stmt); } - } else if (ASR::is_a(*x.m_test)) { - ASR::IntrinsicScalarFunction_t* intrinsic_func = ASR::down_cast(x.m_test); + } else if (ASR::is_a(*x.m_test)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(x.m_test); if (intrinsic_func->m_type->type == ASR::ttypeType::Logical) { - ASR::expr_t* test = process_attributes(al, x.base.base.loc, x.m_test, module_scope); - ASR::stmt_t *assert_stmt = ASRUtils::STMT(ASR::make_Assert_t(al, x.base.base.loc, test, x.m_msg)); - pass_result.push_back(al, assert_stmt); + if (is_logical_intrinsic_symbolic(x.m_test)) { + ASR::expr_t* test = process_attributes(x.base.base.loc, x.m_test); + ASR::stmt_t *assert_stmt = ASRUtils::STMT(ASR::make_Assert_t(al, x.base.base.loc, test, x.m_msg)); + pass_result.push_back(al, assert_stmt); + } } } else if (ASR::is_a(*x.m_test)) { ASR::LogicalBinOp_t* binop = ASR::down_cast(x.m_test); if (ASR::is_a(*binop->m_left) && ASR::is_a(*binop->m_right)) { - ASR::symbol_t* basic_str_sym = declare_basic_str_function(al, x.base.base.loc, module_scope); ASR::SymbolicCompare_t *s1 = ASR::down_cast(binop->m_left); - left_tmp = process_with_basic_str(al, x.base.base.loc, s1->m_left, basic_str_sym); - right_tmp = process_with_basic_str(al, x.base.base.loc, s1->m_right, basic_str_sym); + left_tmp = process_with_basic_str(x.base.base.loc, s1->m_left); + right_tmp = process_with_basic_str(x.base.base.loc, s1->m_right); ASR::expr_t* test1 = ASRUtils::EXPR(ASR::make_StringCompare_t(al, x.base.base.loc, left_tmp, s1->m_op, right_tmp, s1->m_type, s1->m_value)); ASR::SymbolicCompare_t *s2 = ASR::down_cast(binop->m_right); - left_tmp = process_with_basic_str(al, x.base.base.loc, s2->m_left, basic_str_sym); - right_tmp = process_with_basic_str(al, x.base.base.loc, s2->m_right, basic_str_sym); + left_tmp = process_with_basic_str(x.base.base.loc, s2->m_left); + right_tmp = process_with_basic_str(x.base.base.loc, s2->m_right); ASR::expr_t* test2 = ASRUtils::EXPR(ASR::make_StringCompare_t(al, x.base.base.loc, left_tmp, s2->m_op, right_tmp, s2->m_type, s2->m_value)); @@ -1773,26 +1011,25 @@ class ReplaceSymbolicVisitor : public PassUtils::PassVisitor(x); + transform_stmts(xx.m_body, xx.n_body); + if (ASR::is_a(*xx.m_test)) { + ASR::IntrinsicElementalFunction_t* intrinsic_func = ASR::down_cast(xx.m_test); + if (ASR::is_a(*intrinsic_func->m_type)) { + ASR::expr_t* function_call = process_attributes(xx.base.base.loc, xx.m_test); + xx.m_test = function_call; + } + } + } + void visit_Return(const ASR::Return_t &x) { + // freeing out variables if (!symbolic_vars_to_free.empty()){ - SymbolTable* module_scope = current_scope->parent; - // freeing out variables - std::string new_name = "basic_free_stack"; - ASR::symbol_t* basic_free_stack_sym = module_scope->get_symbol(new_name); - for (ASR::symbol_t* symbol : symbolic_vars_to_free) { - if (symbolic_vars_to_omit.find(symbol) != symbolic_vars_to_omit.end()) continue; - Vec call_args; - call_args.reserve(al, 1); - ASR::call_arg_t call_arg; - call_arg.loc = x.base.base.loc; - call_arg.m_value = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, symbol)); - call_args.push_back(al, call_arg); - ASR::stmt_t* stmt = ASRUtils::STMT(ASR::make_SubroutineCall_t(al, x.base.base.loc, basic_free_stack_sym, - basic_free_stack_sym, call_args.p, call_args.n, nullptr)); - pass_result.push_back(al, stmt); + pass_result.push_back(al, basic_free_stack(x.base.base.loc, + ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, symbol)))); } - symbolic_vars_to_free.clear(); pass_result.push_back(al, ASRUtils::STMT(ASR::make_Return_t(al, x.base.base.loc))); } } diff --git a/src/libasr/pass/subroutine_from_function.cpp b/src/libasr/pass/subroutine_from_function.cpp index d7b4c2d..b815869 100644 --- a/src/libasr/pass/subroutine_from_function.cpp +++ b/src/libasr/pass/subroutine_from_function.cpp @@ -175,7 +175,7 @@ class ReplaceFunctionCallWithSubroutineCall: is_return_var_handled = fn->m_return_var == nullptr; } if (is_return_var_handled) { - ASR::ttype_t* result_var_type = x->m_type; + ASR::ttype_t* result_var_type = ASRUtils::duplicate_type(al, x->m_type); bool is_allocatable = false; bool is_func_call_allocatable = false; bool is_result_var_allocatable = false; @@ -302,11 +302,25 @@ class ReplaceFunctionCallWithSubroutineCall: s_args.push_back(al, result_arg); ASR::stmt_t* subrout_call = ASRUtils::STMT(ASRUtils::make_SubroutineCall_t_util(al, loc, x->m_name, nullptr, s_args.p, s_args.size(), nullptr, - nullptr, false)); + nullptr, false, false)); pass_result.push_back(al, subrout_call); } } + void replace_ArrayPhysicalCast(ASR::ArrayPhysicalCast_t* x) { + ASR::BaseExprReplacer::replace_ArrayPhysicalCast(x); + if( (x->m_old == x->m_new && + x->m_old != ASR::array_physical_typeType::DescriptorArray) || + (x->m_old == x->m_new && x->m_old == ASR::array_physical_typeType::DescriptorArray && + (ASR::is_a(*ASRUtils::expr_type(x->m_arg)) || + ASR::is_a(*ASRUtils::expr_type(x->m_arg)))) || + x->m_old != ASRUtils::extract_physical_type(ASRUtils::expr_type(x->m_arg)) ) { + *current_expr = x->m_arg; + } else { + x->m_old = ASRUtils::extract_physical_type(ASRUtils::expr_type(x->m_arg)); + } + } + }; class ReplaceFunctionCallWithSubroutineCallVisitor: @@ -365,7 +379,8 @@ class ReplaceFunctionCallWithSubroutineCallVisitor: void visit_Assignment(const ASR::Assignment_t &x) { if( (ASR::is_a(*ASRUtils::expr_type(x.m_target)) && ASR::is_a(*x.m_value)) || - (ASR::is_a(*x.m_value))) { + (ASR::is_a(*x.m_value) || + ASR::is_a(*x.m_value)) ) { return ; } diff --git a/src/libasr/pass/transform_optional_argument_functions.cpp b/src/libasr/pass/transform_optional_argument_functions.cpp index 7e379fb..fd33065 100644 --- a/src/libasr/pass/transform_optional_argument_functions.cpp +++ b/src/libasr/pass/transform_optional_argument_functions.cpp @@ -5,6 +5,7 @@ #include #include #include +#include #include #include @@ -24,7 +25,7 @@ class ReplacePresentCalls: public ASR::BaseExprReplacer { public: - ReplacePresentCalls(Allocator& al_, ASR::Function_t* f_) : al(al_), f(f_) + ReplacePresentCalls(Allocator& al_, ASR::Function_t* f_) : al{al_}, f{f_} {} void replace_FunctionCall(ASR::FunctionCall_t* x) { @@ -333,6 +334,17 @@ bool fill_new_args(Vec& new_args, Allocator& al, size_t k; bool k_found = false; for( k = 0; k < owning_function->n_args; k++ ) { + ASR::expr_t* original_expr = nullptr; + if (ASR::is_a(*x.m_args[i].m_value)) { + ASR::ArrayPhysicalCast_t *x_array_cast = ASR::down_cast(x.m_args[i].m_value); + original_expr = x_array_cast->m_arg; + } + if( original_expr && ASR::is_a(*original_expr) && ASR::down_cast(owning_function->m_args[k])->m_v == + ASR::down_cast(original_expr)->m_v ) { + k_found = true; + break ; + } + if( ASR::is_a(*x.m_args[i].m_value) && ASR::down_cast(owning_function->m_args[k])->m_v == ASR::down_cast(x.m_args[i].m_value)->m_v ) { k_found = true; @@ -354,6 +366,15 @@ bool fill_new_args(Vec& new_args, Allocator& al, } ASR::call_arg_t present_arg; present_arg.loc = x.m_args[i].loc; + if( x.m_args[i].m_value && + ASRUtils::is_allocatable(x.m_args[i].m_value) && + !ASRUtils::is_allocatable(func_arg_j->m_type) ) { + ASR::expr_t* is_allocated = ASRUtils::EXPR(ASR::make_IntrinsicImpureFunction_t( + al, x.m_args[i].loc, static_cast(ASRUtils::IntrinsicImpureFunctions::Allocated), + &x.m_args[i].m_value, 1, 0, logical_t, nullptr)); + is_present = ASRUtils::EXPR(ASR::make_LogicalBinOp_t(al, x.m_args[i].loc, + is_allocated, ASR::logicalbinopType::And, is_present, logical_t, nullptr)); + } present_arg.m_value = is_present; new_args.push_back(al, present_arg); j++; @@ -440,7 +461,7 @@ class ReplaceSubroutineCallsWithOptionalArgumentsVisitor : public PassUtils::Pas pass_result.push_back(al, ASRUtils::STMT(ASRUtils::make_SubroutineCall_t_util(al, x.base.base.loc, x.m_name, x.m_original_name, new_args.p, new_args.size(), x.m_dt, - nullptr, false))); + nullptr, false, ASRUtils::get_class_proc_nopass_val(x.m_name)))); } }; diff --git a/src/libasr/pass/unique_symbols.cpp b/src/libasr/pass/unique_symbols.cpp index 5a4aab0..fdccda3 100644 --- a/src/libasr/pass/unique_symbols.cpp +++ b/src/libasr/pass/unique_symbols.cpp @@ -7,6 +7,7 @@ #include #include #include +#include extern std::string lcompilers_unique_ID; @@ -46,16 +47,34 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { bool all_symbols_mangling; bool bindc_mangling = false; bool fortran_mangling; + bool c_mangling; bool should_mangle = false; std::vector parent_function_name; std::string module_name = ""; SymbolTable* current_scope = nullptr; - SymbolRenameVisitor(bool mm, bool gm, bool im, bool am, bool bcm, bool fm) : + SymbolRenameVisitor(bool mm, bool gm, bool im, bool am, bool bcm, bool fm, bool cm) : module_name_mangling(mm), global_symbols_mangling(gm), intrinsic_symbols_mangling(im), - all_symbols_mangling(am), bindc_mangling(bcm), fortran_mangling(fm) {} + all_symbols_mangling(am), bindc_mangling(bcm), fortran_mangling(fm), c_mangling(cm) {} + const std::unordered_set reserved_keywords_c = { + "_Alignas", "_Alignof", "_Atomic", "_Bool", "_Complex", "_Generic", + "_Imaginary", "_Noreturn", "_Static_assert", "_Thread_local", "auto", + "break", "case", "char", "_Bool", "const", "continue", "default", "do", + "double", "else", "enum", "extern", "float", "for", "goto", "if", "int", + "long", "register", "return", "short", "signed", "sizeof", "static", + "struct", "switch", "typedef", "union", "unsigned", "void", "volatile", "while" + }; + + //TODO: Implement other backends mangling when refactoring the pass infrastructure + void mangle_c(ASR::symbol_t* sym, const std::string& name){ + if (reserved_keywords_c.find(name) != reserved_keywords_c.end()) { + sym_to_renamed[sym] = "_xx_"+std::string(name)+"_xx_"; + } + return; + } + std::string update_name(std::string curr_name) { if (startswith(curr_name, "_lpython") || startswith(curr_name, "_lfortran") ) { return curr_name; @@ -102,8 +121,7 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { if (all_symbols_mangling || module_name_mangling || should_mangle) { sym_to_renamed[sym] = update_name(x.m_name); } - if ((x.m_intrinsic && intrinsic_symbols_mangling) || - (global_symbols_mangling && startswith(x.m_name, "_global_symbols"))) { + if ((global_symbols_mangling && startswith(x.m_name, "_global_symbols"))) { should_mangle = true; } for (auto &a : x.m_symtab->get_scope()) { @@ -148,6 +166,14 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { "f" + std::string(x.m_name)); } } + if ( c_mangling ) { + ASR::symbol_t *sym = ASR::down_cast((ASR::asr_t*)&x); + mangle_c(sym , std::string(x.m_name)); + } + } + if (intrinsic_symbols_mangling && startswith(x.m_name, "_lcompilers_")) { + ASR::symbol_t *sym = ASR::down_cast((ASR::asr_t*)&x); + sym_to_renamed[sym] = update_name(x.m_name); } for (auto &a : x.m_symtab->get_scope()) { bool nested_function = is_nested_function(a.second); @@ -178,6 +204,9 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { std::string(x.m_name)); } } + if ( c_mangling ) { + mangle_c(sym , std::string(x.m_name)); + } } void visit_GenericProcedure(const ASR::GenericProcedure_t &x) { @@ -204,6 +233,10 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { sym_to_renamed[sym] = update_name(x.m_name); } } + if ( c_mangling ) { + ASR::symbol_t *sym = ASR::down_cast((ASR::asr_t*)&x); + mangle_c(sym , std::string(x.m_name)); + } for (auto &a : x.m_symtab->get_scope()) { this->visit_symbol(*a.second); } @@ -232,6 +265,10 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { sym_to_renamed[sym] = update_name(x.m_name); } } + if (c_mangling ) { + ASR::symbol_t *sym = ASR::down_cast((ASR::asr_t*)&x); + mangle_c(sym , std::string(x.m_name)); + } } template @@ -240,6 +277,10 @@ class SymbolRenameVisitor: public ASR::BaseWalkVisitor { ASR::symbol_t *sym = ASR::down_cast((ASR::asr_t*)&x); sym_to_renamed[sym] = update_name(x.m_name); } + if ( c_mangling ) { + ASR::symbol_t *sym = ASR::down_cast((ASR::asr_t*)&x); + mangle_c(sym , std::string(x.m_name)); + } for (auto &a : x.m_symtab->get_scope()) { this->visit_symbol(*a.second); } @@ -521,8 +562,9 @@ void pass_unique_symbols(Allocator &al, ASR::TranslationUnit_t &unit, if (pass_options.mangle_underscore) { lcompilers_unique_ID = ""; } - if (!any_present || (!(pass_options.mangle_underscore || - pass_options.fortran_mangling) && lcompilers_unique_ID.empty())) { + if ((!any_present || (!(pass_options.mangle_underscore || + pass_options.fortran_mangling) && lcompilers_unique_ID.empty())) && + !pass_options.c_mangling) { // `--mangle-underscore` doesn't require `lcompilers_unique_ID` // `lcompilers_unique_ID` is not mandatory for `--apply-fortran-mangling` return; @@ -532,7 +574,8 @@ void pass_unique_symbols(Allocator &al, ASR::TranslationUnit_t &unit, pass_options.intrinsic_symbols_mangling, pass_options.all_symbols_mangling, pass_options.bindc_mangling, - pass_options.fortran_mangling); + pass_options.fortran_mangling, + pass_options.c_mangling); v.visit_TranslationUnit(unit); UniqueSymbolVisitor u(al, v.sym_to_renamed); u.visit_TranslationUnit(unit); diff --git a/src/libasr/pass/unused_functions.cpp b/src/libasr/pass/unused_functions.cpp index f17fee6..d917967 100644 --- a/src/libasr/pass/unused_functions.cpp +++ b/src/libasr/pass/unused_functions.cpp @@ -45,6 +45,7 @@ class CollectUnusedFunctionsVisitor : for (size_t i=0; im_name; uint64_t h = get_hash((ASR::asr_t*)f); fn_used[h] = name; + h = get_hash((ASR::asr_t*)x.m_v); + fn_used[h] = name; } if (ASR::is_a(*s)) { ASR::GenericProcedure_t *g = ASR::down_cast(s); std::string name = g->m_name; uint64_t h = get_hash((ASR::asr_t*)g); fn_used[h] = name; + h = get_hash((ASR::asr_t*)x.m_v); + fn_used[h] = name; } } @@ -231,7 +236,8 @@ class UnusedFunctionsVisitor : public ASR::BaseWalkVisitor to_be_erased; for (auto it = symtab->get_scope().begin(); it != symtab->get_scope().end(); ++it) { uint64_t h = get_hash((ASR::asr_t*)it->second); - if (symtab->parent && fn_unused.find(h) != fn_unused.end()) { + if ((symtab->parent || (!symtab->parent && startswith(it->first, "_lcompilers_"))) + && fn_unused.find(h) != fn_unused.end()) { to_be_erased.push_back(it->first); } else { this->visit_symbol(*it->second); diff --git a/src/libasr/pass/update_array_dim_intrinsic_calls.cpp b/src/libasr/pass/update_array_dim_intrinsic_calls.cpp index bdacde4..845667a 100644 --- a/src/libasr/pass/update_array_dim_intrinsic_calls.cpp +++ b/src/libasr/pass/update_array_dim_intrinsic_calls.cpp @@ -81,8 +81,11 @@ class ReplaceArrayDimIntrinsicCalls: public ASR::BaseExprReplacerbase.base.loc, 1, x->m_type)); for( int i = 0; i < n; i++ ) { + ASR::expr_t* dim_length = ASRUtils::EXPR(ASR::make_Cast_t( + al, x->base.base.loc, dims[i].m_length, ASR::cast_kindType::IntegerToInteger, x->m_type, nullptr)); + array_size = ASRUtils::EXPR(ASR::make_IntegerBinOp_t(al, x->base.base.loc, - array_size, ASR::binopType::Mul, dims[i].m_length, x->m_type, + array_size, ASR::binopType::Mul, dim_length, x->m_type, nullptr)); } *current_expr = array_size; diff --git a/src/libasr/pass/where.cpp b/src/libasr/pass/where.cpp index 65ff983..d893d69 100644 --- a/src/libasr/pass/where.cpp +++ b/src/libasr/pass/where.cpp @@ -96,7 +96,7 @@ class ReplaceVar : public ASR::BaseExprReplacer BinOpReplacement(make_RealBinOp_t) } - void replace_IntrinsicScalarFunction(ASR::IntrinsicScalarFunction_t* x) { + void replace_IntrinsicElementalFunction(ASR::IntrinsicElementalFunction_t* x) { Vec args; args.reserve(al, x->n_args); for (size_t i=0; in_args; i++) { @@ -107,7 +107,7 @@ class ReplaceVar : public ASR::BaseExprReplacer } ASR::ttype_t* type = ASRUtils::expr_type(args[0]); ASR::expr_t* new_expr = ASRUtils::EXPR( - ASRUtils::make_IntrinsicScalarFunction_t_util(al, x->base.base.loc, + ASRUtils::make_IntrinsicElementalFunction_t_util(al, x->base.base.loc, x->m_intrinsic_id, args.p, x->n_args, x->m_overload_id, type, x->m_value)); *current_expr = new_expr; } @@ -279,7 +279,7 @@ class WhereVisitor : public PassUtils::PassVisitor real_cmp = ASR::down_cast(test); left = real_cmp->m_left; } else { - throw LCompilersException("Unsupported type"); + throw LCompilersException("Unsupported type, " + std::to_string(test->type)); } // Construct a do loop @@ -335,7 +335,7 @@ class WhereVisitor : public PassUtils::PassVisitor } do_loop_body.push_back(al, if_stmt); - doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, 0, head, do_loop_body.p, do_loop_body.size())); + doloop = ASRUtils::STMT(ASR::make_DoLoop_t(al, loc, 0, head, do_loop_body.p, do_loop_body.size(), nullptr, 0)); pass_result.push_back(al, doloop); } }; diff --git a/src/libasr/pass/while_else.cpp b/src/libasr/pass/while_else.cpp new file mode 100644 index 0000000..df44951 --- /dev/null +++ b/src/libasr/pass/while_else.cpp @@ -0,0 +1,126 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +namespace LCompilers { + + +class ExitVisitor : public ASR::StatementWalkVisitor { +public: + + std::unordered_map flag_map; + std::stack loop_stack; + + ExitVisitor(Allocator &al) + : StatementWalkVisitor(al) {} + + void visit_WhileLoop(const ASR::WhileLoop_t &x) { + ASR::stmt_t *while_stmt = (ASR::stmt_t*)(&x); + + loop_stack.push(while_stmt); + ASR::WhileLoop_t &xx = const_cast(x); + transform_stmts(xx.m_body, xx.n_body); + + loop_stack.pop(); + } + + void visit_Exit(const ASR::Exit_t &x) { + if (loop_stack.empty() || + flag_map.find(loop_stack.top()) == flag_map.end()) + return; + + Vec result; + result.reserve(al, 2); + + Location loc = x.base.base.loc; + ASR::ttype_t *bool_type = ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)); + ASR::expr_t *false_expr = ASRUtils::EXPR(ASR::make_LogicalConstant_t(al, loc, false, bool_type)); + ASR::expr_t *flag_expr = ASRUtils::EXPR(ASR::make_Var_t(al, loc, flag_map.at(loop_stack.top()))); + ASR::stmt_t *assign_stmt = ASRUtils::STMT( + ASR::make_Assignment_t(al, loc, flag_expr, false_expr, nullptr)); + result.push_back(al, assign_stmt); + result.push_back(al, ASRUtils::STMT(ASR::make_Exit_t(al, loc, nullptr))); + + pass_result = result; + } +}; + +class WhileLoopVisitor : public ASR::StatementWalkVisitor +{ +private: + int counter; + +public: + std::unordered_map flag_map; + + WhileLoopVisitor(Allocator &al) : StatementWalkVisitor(al) { + counter = 0; + flag_map = {}; + } + + void visit_WhileLoop(const ASR::WhileLoop_t &x) { + Location loc = x.base.base.loc; + auto target_scope = current_scope; + + /* + Creating a flag variable in case of a while-else loop + Creates an if statement after the loop to check if the flag was changed + */ + if (x.n_orelse > 0) { + Vec result; + result.reserve(al, 3); + + Str s; + s.from_str_view(std::string("_no_break_") + std::to_string(counter)); + counter++; + + ASR::ttype_t *bool_type = ASRUtils::TYPE(ASR::make_Logical_t(al, loc, 4)); + ASR::expr_t *true_expr = ASRUtils::EXPR(ASR::make_LogicalConstant_t(al, loc, true, bool_type)); + ASR::symbol_t *flag_symbol = LCompilers::ASR::down_cast( + ASR::make_Variable_t( + al, loc, target_scope, + s.c_str(al), nullptr, 0, ASR::intentType::Local, nullptr, nullptr, + ASR::storage_typeType::Default, bool_type, nullptr, + ASR::abiType::Source, ASR::Public, + ASR::presenceType::Required, false)); + target_scope-> add_symbol(s.c_str(al), flag_symbol); + ASR::expr_t* flag_expr = ASRUtils::EXPR(ASR::make_Var_t(al, loc, flag_symbol)); + + ASR::stmt_t *assign_stmt = ASRUtils::STMT( + ASR::make_Assignment_t(al, loc, flag_expr, true_expr, nullptr)); + + ASR::stmt_t *while_stmt = (ASR::stmt_t*)(&x); + flag_map[while_stmt] = flag_symbol; + + result.push_back(al, assign_stmt); + result.push_back(al, while_stmt); + result.push_back(al, ASRUtils::STMT( + ASR::make_If_t(al, loc, flag_expr, x.m_orelse, x.n_orelse, nullptr, 0))); + pass_result = result; + } else { + Vec result; + result.reserve(al, 1); + result.push_back(al, (ASR::stmt_t*)(&x)); + pass_result = result; + } + } +}; + +void pass_while_else(Allocator &al, ASR::TranslationUnit_t &unit, + const LCompilers::PassOptions& /*pass_options*/) { + WhileLoopVisitor v(al); + ExitVisitor e(al); + v.visit_TranslationUnit(unit); + e.flag_map = v.flag_map; + e.visit_TranslationUnit(unit); +} + + +} // namespace LCompilers diff --git a/src/libasr/pass/while_else.h b/src/libasr/pass/while_else.h new file mode 100644 index 0000000..13ebb2f --- /dev/null +++ b/src/libasr/pass/while_else.h @@ -0,0 +1,14 @@ +#ifndef LIBASR_PASS_WHILE_ELSE_H +#define LIBASR_PASS_WHILE_ELSE_H + +#include +#include + +namespace LCompilers { + +void pass_while_else(Allocator &al, ASR::TranslationUnit_t &unit, + const PassOptions &pass_options); +} // namespace LCompilers + +#endif // LIBASR_PASS_WHILE_ELSE_H + diff --git a/src/libasr/pickle.cpp b/src/libasr/pickle.cpp index 5c54d69..79e7171 100644 --- a/src/libasr/pickle.cpp +++ b/src/libasr/pickle.cpp @@ -52,13 +52,13 @@ class ASRPickleVisitor : } void visit_Module(const ASR::Module_t &x) { if (!show_intrinsic_modules && - startswith(x.m_name, "lfortran_intrinsic_")) { + (x.m_intrinsic || startswith(x.m_name, "lfortran_intrinsic_") || startswith(x.m_name, "numpy"))) { s.append("("); if (use_colors) { s.append(color(style::bold)); s.append(color(fg::magenta)); } - s.append("IntrinsicModule"); + s.append(x.m_intrinsic ? "IntrinsicModule" : "Module"); if (use_colors) { s.append(color(fg::reset)); s.append(color(style::reset)); diff --git a/src/libasr/runtime/lfortran_intrinsics.c b/src/libasr/runtime/lfortran_intrinsics.c index 3ad73c5..075f46e 100644 --- a/src/libasr/runtime/lfortran_intrinsics.c +++ b/src/libasr/runtime/lfortran_intrinsics.c @@ -10,7 +10,7 @@ #include #include -#if defined(_MSC_VER) +#if defined(_WIN32) # include # include # define ftruncate _chsize_s @@ -115,7 +115,18 @@ LFORTRAN_API void _lfortran_init_random_seed(unsigned seed) LFORTRAN_API void _lfortran_init_random_clock() { - srand((unsigned int)clock()); + unsigned int count; +#if defined(_WIN32) + count = (unsigned int)clock(); +#else + struct timespec ts; + if (clock_gettime(CLOCK_MONOTONIC, &ts) == 0) { + count = (unsigned int)(ts.tv_nsec); + } else { + count = (unsigned int)clock(); + } +#endif + srand(count); } LFORTRAN_API double _lfortran_random() @@ -160,10 +171,10 @@ char* append_to_string(char* str, const char* append) { return str; } -void handle_integer(char* format, int val, char** result) { +void handle_integer(char* format, int64_t val, char** result) { int width = 0, min_width = 0; char* dot_pos = strchr(format, '.'); - int len = (val == 0) ? 1 : (int)log10(abs(val)) + 1; + int len = (val == 0) ? 1 : (int)log10(llabs(val)) + 1; int sign_width = (val < 0) ? 1 : 0; if (dot_pos != NULL) { dot_pos++; @@ -196,8 +207,7 @@ void handle_integer(char* format, int val, char** result) { for (int i = 0; i < (min_width - len - sign_width); i++) { *result = append_to_string(*result, "0"); } - } - else { + } else { for (int i = 0; i < (width - len - sign_width); i++) { *result = append_to_string(*result, " "); } @@ -206,7 +216,7 @@ void handle_integer(char* format, int val, char** result) { } } char str[20]; - sprintf(str, "%d", abs(val)); + sprintf(str, "%lld", llabs(val)); *result = append_to_string(*result, str); } else { for (int i = 0; i < width; i++) { @@ -215,6 +225,18 @@ void handle_integer(char* format, int val, char** result) { } } +void handle_logical(char* format, bool val, char** result) { + int width = atoi(format + 1); + for (int i = 0; i < width - 1; i++) { + *result = append_to_string(*result, " "); + } + if (val) { + *result = append_to_string(*result, "T"); + } else { + *result = append_to_string(*result, "F"); + } +} + void handle_float(char* format, double val, char** result) { int width = 0, decimal_digits = 0; long integer_part = (long)fabs(val); @@ -286,44 +308,64 @@ void handle_float(char* format, double val, char** result) { } void handle_decimal(char* format, double val, int scale, char** result, char* c) { + // Consider an example: write(*, "(es10.2)") 1.123e+10 + // format = "es10.2", val = 11230000128.00, scale = 0, c = "E" int width = 0, decimal_digits = 0; - int64_t integer_part = (int64_t)val; int sign_width = (val < 0) ? 1 : 0; - int integer_length = (integer_part == 0) ? 1 : (int)log10(llabs(integer_part)) + 1; + // sign_width = 0 + double integer_part = trunc(val); + int integer_length = (integer_part == 0) ? 1 : (int)log10(fabs(integer_part)) + 1; + // integer_part = 11230000128, integer_length = 11 char *num_pos = format ,*dot_pos = strchr(format, '.'); decimal_digits = atoi(++dot_pos); while(!isdigit(*num_pos)) num_pos++; width = atoi(num_pos); + // width = 10, decimal_digits = 2 - char val_str[64]; + char val_str[128]; // TODO: This will work for up to `E65.60` but will fail for: // print "(E67.62)", 1.23456789101112e-62_8 sprintf(val_str, "%.*lf", (60-integer_length), val); + // val_str = "11230000128.00..." int i = strlen(val_str) - 1; while (val_str[i] == '0') { val_str[i] = '\0'; i--; } + // val_str = "11230000128." + + int exp = 2; + char* exp_loc = strchr(num_pos, 'e'); + if (exp_loc != NULL) { + exp = atoi(++exp_loc); + } + // exp = 2; char* ptr = strchr(val_str, '.'); if (ptr != NULL) { memmove(ptr, ptr + 1, strlen(ptr)); } + // val_str = "11230000128" if (val < 0) { + // removes `-` (negative) sign memmove(val_str, val_str + 1, strlen(val_str)); } int decimal = 1; while (val_str[0] == '0') { + // Used for the case: 1.123e-10 memmove(val_str, val_str + 1, strlen(val_str)); decimal--; + // loop end: decimal = -9 } - if (format[1] == 'S') { + if (tolower(format[1]) == 's') { scale = 1; decimal--; + // decimal = 0, case: 1.123e+10 + // decimal = -10, case: 1.123e-10 } if (dot_pos != NULL) { @@ -350,6 +392,7 @@ void handle_decimal(char* format, double val, int scale, char** result, char* c) char formatted_value[64] = ""; int spaces = width - sign_width - decimal_digits - 6; + // spaces = 2 if (scale > 1) { decimal_digits -= scale - 1; } @@ -358,6 +401,7 @@ void handle_decimal(char* format, double val, int scale, char** result, char* c) } if (sign_width == 1) { + // adds `-` (negative) sign strcat(formatted_value, "-"); } if (scale <= 0) { @@ -380,13 +424,16 @@ void handle_decimal(char* format, double val, int scale, char** result, char* c) char* temp = substring(val_str, 0, scale); strcat(formatted_value, temp); strcat(formatted_value, "."); + // formatted_value = " 1." char* new_str = substring(val_str, scale, strlen(val_str)); + // new_str = "1230000128" case: 1.123e+10 int zeros = 0; if (decimal_digits < strlen(new_str) && decimal_digits + scale <= 15) { new_str[15] = '\0'; zeros = strspn(new_str, "0"); long long t = (long long)round((long double)atoll(new_str) / (long long) pow(10, (strlen(new_str) - decimal_digits))); sprintf(new_str, "%lld", t); + // new_str = 12 int index = zeros; while(index--) { memmove(new_str + 1, new_str, strlen(new_str)+1); @@ -395,20 +442,24 @@ void handle_decimal(char* format, double val, int scale, char** result, char* c) } new_str[decimal_digits] = '\0'; strcat(formatted_value, new_str); + // formatted_value = " 1.12" free(new_str); free(temp); } strcat(formatted_value, c); + // formatted_value = " 1.12E" char exponent[12]; if (atoi(num_pos) == 0) { sprintf(exponent, "%+02d", (integer_length > 0 && integer_part != 0 ? integer_length - scale : decimal)); } else { - sprintf(exponent, "%+03d", (integer_length > 0 && integer_part != 0 ? integer_length - scale : decimal)); + sprintf(exponent, "%+0*d", exp+1, (integer_length > 0 && integer_part != 0 ? integer_length - scale : decimal)); + // exponent = "+10" } strcat(formatted_value, exponent); + // formatted_value = " 1.12E+10" if (strlen(formatted_value) == width + 1 && scale <= 0) { char* ptr = strchr(formatted_value, '0'); @@ -423,6 +474,7 @@ void handle_decimal(char* format, double val, int scale, char** result, char* c) } } else { *result = append_to_string(*result, formatted_value); + // result = " 1.12E+10" } } @@ -444,6 +496,9 @@ char** parse_fortran_format(char* format, int *count, int *item_start) { case '/' : format_values_2[format_values_count++] = substring(format, index, index+1); break; + case '*' : + format_values_2[format_values_count++] = substring(format, index, index+1); + break; case '"' : start = index++; while (format[index] != '"') { @@ -471,11 +526,20 @@ char** parse_fortran_format(char* format, int *count, int *item_start) { case 'd' : case 'e' : case 'f' : + case 'l' : start = index++; + bool dot = false; if(tolower(format[index]) == 's') index++; while (isdigit(format[index])) index++; - if (format[index] == '.') index++; + if (format[index] == '.') { + dot = true; + index++; + } while (isdigit(format[index])) index++; + if (dot && tolower(format[index]) == 'e') { + index++; + while (isdigit(format[index])) index++; + } format_values_2[format_values_count++] = substring(format, start, index); index--; break; @@ -486,12 +550,11 @@ char** parse_fortran_format(char* format, int *count, int *item_start) { *item_start = format_values_count; break; default : - if (isdigit(format[index]) && tolower(format[index+1]) == 'p') { + if ( + (format[index] == '-' && isdigit(format[index + 1]) && tolower(format[index + 2]) == 'p') + || ((isdigit(format[index])) && tolower(format[index + 1]) == 'p')) { start = index; - if (index > 0 && format[index-1] == '-') { - start = index - 1; - } - index = index + 1; + index = index + 1 + (format[index] == '-'); format_values_2[format_values_count++] = substring(format, start, index + 1); } else if (isdigit(format[index])) { start = index; @@ -519,6 +582,9 @@ char** parse_fortran_format(char* format, int *count, int *item_start) { } index--; } + } else if (format[index] != ' ') { + fprintf(stderr, "Unsupported or unrecognized `%c` in format string\n", format[index]); + exit(1); } } index++; @@ -537,13 +603,14 @@ LFORTRAN_API char* _lcompilers_string_format_fortran(int count, const char* form modified_input_string[len] = '\0'; if (format[0] == '(' && format[len-1] == ')') { memmove(modified_input_string, modified_input_string + 1, strlen(modified_input_string)); - modified_input_string[len-1] = '\0'; + modified_input_string[len-2] = '\0'; } int format_values_count = 0,item_start_idx=0; char** format_values = parse_fortran_format(modified_input_string,&format_values_count,&item_start_idx); char* result = (char*)malloc(sizeof(char)); result[0] = '\0'; int item_start = 0; + bool array = false; while (1) { int scale = 0; for (int i = item_start; i < format_values_count; i++) { @@ -577,6 +644,8 @@ LFORTRAN_API char* _lcompilers_string_format_fortran(int count, const char* form if (value[0] == '/') { result = append_to_string(result, "\n"); + } else if (value[0] == '*') { + array = true; } else if (isdigit(value[0]) && tolower(value[1]) == 'p') { // Scale Factor nP scale = atoi(&value[0]); @@ -616,7 +685,7 @@ LFORTRAN_API char* _lcompilers_string_format_fortran(int count, const char* form // Integer Editing ( I[w[.m]] ) if ( count == 0 ) break; count--; - int val = va_arg(args, int); + int64_t val = va_arg(args, int64_t); handle_integer(value, val, &result); } else if (tolower(value[0]) == 'd') { // D Editing (D[w[.d]]) @@ -636,13 +705,23 @@ LFORTRAN_API char* _lcompilers_string_format_fortran(int count, const char* form count--; double val = va_arg(args, double); handle_float(value, val, &result); + } else if (tolower(value[0]) == 'l') { + if ( count == 0 ) break; + count--; + char* val_str = va_arg(args, char*); + bool val = (strcmp(val_str, "True") == 0); + handle_logical(value, val, &result); } else if (strlen(value) != 0) { + if ( count == 0 ) break; + count--; printf("Printing support is not available for %s format.\n",value); } } if ( count > 0 ) { - result = append_to_string(result, "\n"); + if (!array) { + result = append_to_string(result, "\n"); + } item_start = item_start_idx; } else { break; @@ -794,16 +873,6 @@ LFORTRAN_API double_complex_t _lfortran_zsqrt(double_complex_t x) // aimag ----------------------------------------------------------------------- -LFORTRAN_API float _lfortran_caimag(float_complex_t x) -{ - return cimagf(x); -} - -LFORTRAN_API double _lfortran_zaimag(double_complex_t x) -{ - return cimag(x); -} - LFORTRAN_API void _lfortran_complex_aimag_32(struct _lfortran_complex_32 *x, float *res) { *res = x->im; @@ -848,6 +917,14 @@ LFORTRAN_API double _lfortran_dlog(double x) return log(x); } +LFORTRAN_API bool _lfortran_rsp_is_nan(float x) { + return isnan(x); +} + +LFORTRAN_API bool _lfortran_rdp_is_nan(double x) { + return isnan(x); +} + LFORTRAN_API float_complex_t _lfortran_clog(float_complex_t x) { return clogf(x); @@ -918,6 +995,622 @@ LFORTRAN_API double _lfortran_dlog_gamma(double x) return lgamma(x); } +// besselj0 -------------------------------------------------------------------- + +/** +* Ported from implementation done at: +* https://github.com/stdlib-js/stdlib/blob/develop/lib/node_modules/%40stdlib/math/base/special/besselj0/lib/main.js +* +* All credits to the original authors of the implementation. +*/ + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj0_rational_p1q1( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.17291506903064494; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -412986685009.9087 + (x * (27282507878.60594 + (x * (-621407004.2354012 + (x * (6630299.79048338 + (x * (-36629.81465510709 + (x * (103.44222815443189 + (x * -0.12117036164593528))))))))))); + s2 = 2388378799633.229 + (x * (26328198300.85965 + (x * (139850973.72263435 + (x * (456126.9622421994 + (x * (936.1402239233771 + (x * (1.0 + (x * 0.0))))))))))); + } else { + ix = 1.0 / x; + s1 = -0.12117036164593528 + (ix * (103.44222815443189 + (ix * (-36629.81465510709 + (ix * (6630299.79048338 + (ix * (-621407004.2354012 + (ix * (27282507878.60594 + (ix * -412986685009.9087))))))))))); + s2 = 0.0 + (ix * (1.0 + (ix * (936.1402239233771 + (ix * (456126.9622421994 + (ix * (139850973.72263435 + (ix * (26328198300.85965 + (ix * 2388378799633.229))))))))))); + } + return s1 / s2; +} + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj0_rational_p2q2( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return 0.005119512965174424; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -1831.9397969392085 + (x * (-12254.07816137899 + (x * (-7287.970246446462 + (x * (10341.910641583727 + (x * (11725.046279757104 + (x * (4417.670702532509 + (x * (743.2119668062425 + (x * 48.5917033559165))))))))))))); + s2 = -357834.78026152303 + (x * (245991.0226258631 + (x * (-84055.06259116957 + (x * (18680.99000835919 + (x * (-2945.876654550934 + (x * (333.07310774649073 + (x * (-25.258076240801554 + (x * 1.0))))))))))))); + } else { + ix = 1.0 / x; + s1 = 48.5917033559165 + (ix * (743.2119668062425 + (ix * (4417.670702532509 + (ix * (11725.046279757104 + (ix * (10341.910641583727 + (ix * (-7287.970246446462 + (ix * (-12254.07816137899 + (ix * -1831.9397969392085))))))))))))); + s2 = 1.0 + (ix * (-25.258076240801554 + (ix * (333.07310774649073 + (ix * (-2945.876654550934 + (ix * (18680.99000835919 + (ix * (-84055.06259116957 + (ix * (245991.0226258631 + (ix * -357834.78026152303))))))))))))); + } + return s1 / s2; +} + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj0_rational_pcqc( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return 1.0; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = 22779.090197304686 + (x * (41345.38663958076 + (x * (21170.523380864943 + (x * (3480.648644324927 + (x * (153.76201909008356 + (x * 0.8896154842421046))))))))); + s2 = 22779.090197304686 + (x * (41370.41249551042 + (x * (21215.350561880117 + (x * (3502.8735138235606 + (x * (157.11159858080893 + (x * 1.0))))))))); + } else { + ix = 1.0 / x; + s1 = 0.8896154842421046 + (ix * (153.76201909008356 + (ix * (3480.648644324927 + (ix * (21170.523380864943 + (ix * (41345.38663958076 + (ix * 22779.090197304686))))))))); + s2 = 1.0 + (ix * (157.11159858080893 + (ix * (3502.8735138235606 + (ix * (21215.350561880117 + (ix * (41370.41249551042 + (ix * 22779.090197304686))))))))); + } + return s1 / s2; +} + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj0_rational_psqs( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.015625; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -89.22660020080009 + (x * (-185.91953644342993 + (x * (-111.83429920482737 + (x * (-22.300261666214197 + (x * (-1.244102674583564 + (x * -0.008803330304868075))))))))); + s2 = 5710.502412851206 + (x * (11951.131543434614 + (x * (7264.278016921102 + (x * (1488.7231232283757 + (x * (90.59376959499312 + (x * 1.0))))))))); + } else { + ix = 1.0 / x; + s1 = -0.008803330304868075 + (ix * (-1.244102674583564 + (ix * (-22.300261666214197 + (ix * (-111.83429920482737 + (ix * (-185.91953644342993 + (ix * -89.22660020080009))))))))); + s2 = 1.0 + (ix * (90.59376959499312 + (ix * (1488.7231232283757 + (ix * (7264.278016921102 + (ix * (11951.131543434614 + (ix * 5710.502412851206))))))))); + } + return s1 / s2; +} + +LFORTRAN_API double _lfortran_dbesselj0( double x ) { + double rc; + double rs; + double si; + double co; + double y2; + double r; + double y; + double f; + + double ONE_DIV_SQRT_PI = 0.5641895835477563; + double x1 = 2.4048255576957727686e+00; + double x2 = 5.5200781102863106496e+00; + double x11 = 6.160e+02; + double x12 = -1.42444230422723137837e-03; + double x21 = 1.4130e+03; + double x22 = 5.46860286310649596604e-04; + + if ( x < 0 ) { + x = -x; + } + if ( x == HUGE_VAL ) { + return 0.0; + } + if ( x == 0 ) { + return 1.0; + } + if ( x <= 4.0 ) { + y = x * x; + r = besselj0_rational_p1q1( y ); + f = ( x+x1 ) * ( (x - (x11/256.0)) - x12 ); + return f * r; + } + if ( x <= 8.0 ) { + y = 1.0 - ( ( x*x )/64.0 ); + r = besselj0_rational_p2q2( y ); + f = ( x+x2 ) * ( (x - (x21/256.0)) - x22 ); + return f * r; + } + y = 8.0 / x; + y2 = y * y; + rc = besselj0_rational_pcqc( y2 ); + rs = besselj0_rational_psqs( y2 ); + f = ONE_DIV_SQRT_PI / sqrt(x); + + // __sincos(x, &si, &co); + si = sin(x); + co = cos(x); + return f * ( ( rc * (co+si) ) - ( (y*rs) * (si-co) ) ); +} + +LFORTRAN_API float _lfortran_sbesselj0( float x ) { + return (float)_lfortran_dbesselj0((double)x); +} + +// besselj1 -------------------------------------------------------------------- + +/** +* Ported from implementation done at: +* https://github.com/stdlib-js/stdlib/blob/develop/lib/node_modules/%40stdlib/math/base/special/besselj1/lib/main.js +* +* All credits to the original authors of the implementation. +*/ + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj1_rational_p1q1( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.03405537391318949; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -142585098013.66644 + (x * (6678104126.14924 + (x * (-115486967.64841276 + (x * (980629.0409895825 + (x * (-4461.579298277507 + (x * (10.650724020080236 + (x * -0.010767857011487301))))))))))); + s2 = 4186860446082.0176 + (x * (42091902282.58013 + (x * (202283751.40097034 + (x * (591176.1449417479 + (x * (1074.227223951738 + (x * (1.0 + (x * 0.0))))))))))); + } else { + ix = 1.0 / x; + s1 = -0.010767857011487301 + (ix * (10.650724020080236 + (ix * (-4461.579298277507 + (ix * (980629.0409895825 + (ix * (-115486967.64841276 + (ix * (6678104126.14924 + (ix * -142585098013.66644))))))))))); + s2 = 0.0 + (ix * (1.0 + (ix * (1074.227223951738 + (ix * (591176.1449417479 + (ix * (202283751.40097034 + (ix * (42091902282.58013 + (ix * 4186860446082.0176))))))))))); + } + return s1 / s2; +} + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj1_rational_p2q2( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.010158790774176108; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -17527881995806512.0 + (x * (1660853173129901.8 + (x * (-36658018905416.664 + (x * (355806656709.1062 + (x * (-1811393126.9860668 + (x * (5079326.614801118 + (x * (-7502.334222078161 + (x * 4.6179191852758255))))))))))))); + s2 = 1725390588844768000.0 + (x * (17128800897135812.0 + (x * (84899346165481.42 + (x * (276227772862.44086 + (x * (648725028.9959639 + (x * (1126712.5065029138 + (x * (1388.6978985861358 + (x * 1.0))))))))))))); + } else { + ix = 1.0 / x; + s1 = 4.6179191852758255 + (ix * (-7502.334222078161 + (ix * (5079326.614801118 + (ix * (-1811393126.9860668 + (ix * (355806656709.1062 + (ix * (-36658018905416.664 + (ix * (1660853173129901.8 + (ix * -17527881995806512.0))))))))))))); + s2 = 1.0 + (ix * (1388.6978985861358 + (ix * (1126712.5065029138 + (ix * (648725028.9959639 + (ix * (276227772862.44086 + (ix * (84899346165481.42 + (ix * (17128800897135812.0 + (ix * 1725390588844768000.0))))))))))))); + } + return s1 / s2; +} + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj1_rational_pcqc( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return 1.0; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -4435757.816794128 + (x * (-9942246.505077641 + (x * (-6603373.248364939 + (x * (-1523529.3511811374 + (x * (-109824.05543459347 + (x * (-1611.6166443246102 + (x * 0.0))))))))))); + s2 = -4435757.816794128 + (x * (-9934124.389934586 + (x * (-6585339.4797230875 + (x * (-1511809.5066341609 + (x * (-107263.8599110382 + (x * (-1455.0094401904962 + (x * 1.0))))))))))); + } else { + ix = 1.0 / x; + s1 = 0.0 + (ix * (-1611.6166443246102 + (ix * (-109824.05543459347 + (ix * (-1523529.3511811374 + (ix * (-6603373.248364939 + (ix * (-9942246.505077641 + (ix * -4435757.816794128))))))))))); + s2 = 1.0 + (ix * (-1455.0094401904962 + (ix * (-107263.8599110382 + (ix * (-1511809.5066341609 + (ix * (-6585339.4797230875 + (ix * (-9934124.389934586 + (ix * -4435757.816794128))))))))))); + } + return s1 / s2; +} + +/** +* Evaluates a rational function (i.e., the ratio of two polynomials described by the coefficients stored in \\(P\\) and \\(Q\\)). +* +* ## Notes +* +* - Coefficients should be sorted in ascending degree. +* - The implementation uses [Horner's rule][horners-method] for efficient computation. +* +* [horners-method]: https://en.wikipedia.org/wiki/Horner%27s_method +* +* @param x value at which to evaluate the rational function +* @return evaluated rational function +*/ +static double besselj1_rational_psqs( const double x ) { + double ax; + double ix; + double s1; + double s2; + if ( x == 0.0 ) { + return 0.046875; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = 33220.913409857225 + (x * (85145.1606753357 + (x * (66178.83658127084 + (x * (18494.262873223866 + (x * (1706.375429020768 + (x * (35.26513384663603 + (x * 0.0))))))))))); + s2 = 708712.8194102874 + (x * (1819458.0422439973 + (x * (1419460.669603721 + (x * (400294.43582266977 + (x * (37890.2297457722 + (x * (863.8367769604992 + (x * 1.0))))))))))); + } else { + ix = 1.0 / x; + s1 = 0.0 + (ix * (35.26513384663603 + (ix * (1706.375429020768 + (ix * (18494.262873223866 + (ix * (66178.83658127084 + (ix * (85145.1606753357 + (ix * 33220.913409857225))))))))))); + s2 = 1.0 + (ix * (863.8367769604992 + (ix * (37890.2297457722 + (ix * (400294.43582266977 + (ix * (1419460.669603721 + (ix * (1819458.0422439973 + (ix * 708712.8194102874))))))))))); + } + return s1 / s2; +} + +LFORTRAN_API double _lfortran_dbesselj1( double x ) { + double value; + double rc; + double rs; + double si; + double co; + double y2; + double r; + double y; + double f; + double w; + + double SQRT_PI = 1.7724538509055160; + double x1 = 3.8317059702075123156e+00; + double x2 = 7.0155866698156187535e+00; + double x11 = 9.810e+02; + double x12 = -3.2527979248768438556e-04; + double x21 = 1.7960e+03; + double x22 = -3.8330184381246462950e-05; + + w = fabs( x ); + if ( x == 0.0 ) { + return 0.0; + } + if ( w == HUGE_VAL ) { + return 0.0; + } + if ( w <= 4.0 ) { + y = x * x; + r = besselj1_rational_p1q1( y ); + f = w * ( w+x1 ) * ( ( w - (x11/256.0) ) - x12 ); + value = f * r; + } else if ( w <= 8.0 ) { + y = x * x; + r = besselj1_rational_p2q2( y ); + f = w * ( w+x2 ) * ( ( w - (x21/256.0) ) - x22 ); + value = f * r; + } else { + y = 8.0 / w; + y2 = y * y; + rc = besselj1_rational_pcqc( y2 ); + rs = besselj1_rational_psqs( y2 ); + f = 1.0 / ( sqrt(w) * SQRT_PI ); + + // __sincos(w, &si, &co); + si = sin(w); + co = cos(w); + value = f * ( ( rc * (si-co) ) + ( (y*rs) * (si+co) ) ); + } + if ( x < 0.0 ) { + value = -1.0 * value; + } + return value; +} + +LFORTRAN_API float _lfortran_sbesselj1( float x ) { + return (float)_lfortran_dbesselj1((double)x); +} + +static double bessely0_rational_p1q1( double x ) { + double ax; + double s1; + double s2; + if ( x == 0.0 ) { + return 0.18214429522164177; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = 107235387820.03177 + (x * (-8371625545.12605 + (x * (204222743.5737662 + (x * (-2128754.84744018 + (x * (10102.532948020907 + (x * -18.402381979244993))))))))); + s2 = 588738657389.9703 + (x * (8161718777.729036 + (x * (55662956.624278255 + (x * (238893.93209447255 + (x * (664.7598668924019 + (x * 1.0))))))))); + } else { + x = 1.0 / x; + s1 = -18.402381979244993 + (x * (10102.532948020907 + (x * (-2128754.84744018 + (x * (204222743.5737662 + (x * (-8371625545.12605 + (x * 107235387820.03177))))))))); + s2 = 1.0 + (x * (664.7598668924019 + (x * (238893.93209447255 + (x * (55662956.624278255 + (x * (8161718777.729036 + (x * 588738657389.9703))))))))); + } + return s1 / s2; +} + +static double bessely0_rational_p2q2( double x ) { + double ax; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.051200622130023854; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -22213976967566.19 + (x * (-551074352067.2264 + (x * (43600098638.60306 + (x * (-695904393.9461962 + (x * (4690528.861167863 + (x * (-14566.865832663636 + (x * 17.427031242901595))))))))))); + s2 = 433861465807072.6 + (x * (5426682441941.234 + (x * (34015103849.97124 + (x * (139602027.7098683 + (x * (406699.82352539554 + (x * (830.3085761207029 + (x * 1.0))))))))))); + } else { + x = 1.0 / x; + s1 = 17.427031242901595 + (x * (-14566.865832663636 + (x * (4690528.861167863 + (x * (-695904393.9461962 + (x * (43600098638.60306 + (x * (-551074352067.2264 + (x * -22213976967566.19))))))))))); + s2 = 1.0 + (x * (830.3085761207029 + (x * (406699.82352539554 + (x * (139602027.7098683 + (x * (34015103849.97124 + (x * (5426682441941.234 + (x * 433861465807072.6))))))))))); + } + return s1 / s2; +} + +static double bessely0_rational_p3q3( double x ) { + double ax; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.023356489432789604; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -8072872690515021.0 + (x * (670166418691732.4 + (x * (-128299123640.88687 + (x * (-193630512667.72083 + (x * (2195882717.0518103 + (x * (-10085539.923498211 + (x * (21363.5341693139 + (x * -17.439661319197498))))))))))))); + s2 = 345637246288464600.0 + (x * (3927242556964031.0 + (x * (22598377924042.9 + (x * (86926121104.20982 + (x * (247272194.75672302 + (x * (539247.3920976806 + (x * (879.0336216812844 + (x * 1.0))))))))))))); + } else { + x = 1.0 / x; + s1 = -17.439661319197498 + (x * (21363.5341693139 + (x * (-10085539.923498211 + (x * (2195882717.0518103 + (x * (-193630512667.72083 + (x * (-128299123640.88687 + (x * (670166418691732.4 + (x * -8072872690515021.0))))))))))))); + s2 = 1.0 + (x * (879.0336216812844 + (x * (539247.3920976806 + (x * (247272194.75672302 + (x * (86926121104.20982 + (x * (22598377924042.9 + (x * (3927242556964031.0 + (x * 345637246288464600.0))))))))))))); + } + return s1 / s2; +} + +static double bessely0_rational_pcqc( double x ) { + double ax; + double s1; + double s2; + if ( x == 0.0 ) { + return 1.0; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = 22779.090197304686 + (x * (41345.38663958076 + (x * (21170.523380864943 + (x * (3480.648644324927 + (x * (153.76201909008356 + (x * 0.8896154842421046))))))))); // eslint-disable-line max-len + s2 = 22779.090197304686 + (x * (41370.41249551042 + (x * (21215.350561880117 + (x * (3502.8735138235606 + (x * (157.11159858080893 + (x * 1.0))))))))); // eslint-disable-line max-len + } else { + x = 1.0 / x; + s1 = 0.8896154842421046 + (x * (153.76201909008356 + (x * (3480.648644324927 + (x * (21170.523380864943 + (x * (41345.38663958076 + (x * 22779.090197304686))))))))); // eslint-disable-line max-len + s2 = 1.0 + (x * (157.11159858080893 + (x * (3502.8735138235606 + (x * (21215.350561880117 + (x * (41370.41249551042 + (x * 22779.090197304686))))))))); // eslint-disable-line max-len + } + return s1 / s2; +} + +static double bessely0_rational_psqs( double x ) { + double ax; + double s1; + double s2; + if ( x == 0.0 ) { + return -0.015625; + } + if ( x < 0.0 ) { + ax = -x; + } else { + ax = x; + } + if ( ax <= 1.0 ) { + s1 = -89.22660020080009 + (x * (-185.91953644342993 + (x * (-111.83429920482737 + (x * (-22.300261666214197 + (x * (-1.244102674583564 + (x * -0.008803330304868075))))))))); // eslint-disable-line max-len + s2 = 5710.502412851206 + (x * (11951.131543434614 + (x * (7264.278016921102 + (x * (1488.7231232283757 + (x * (90.59376959499312 + (x * 1.0))))))))); // eslint-disable-line max-len + } else { + x = 1.0 / x; + s1 = -0.008803330304868075 + (x * (-1.244102674583564 + (x * (-22.300261666214197 + (x * (-111.83429920482737 + (x * (-185.91953644342993 + (x * -89.22660020080009))))))))); // eslint-disable-line max-len + s2 = 1.0 + (x * (90.59376959499312 + (x * (1488.7231232283757 + (x * (7264.278016921102 + (x * (11951.131543434614 + (x * 5710.502412851206))))))))); // eslint-disable-line max-len + } + return s1 / s2; +} + +LFORTRAN_API double _lfortran_dbessely0( double x ) { + + double PI = 3.14159265358979323846; + double SQRT_PI = 1.7724538509055160273; + double ONE_DIV_SQRT_PI = 1.0 / SQRT_PI; + double TWO_DIV_PI = 2.0 / PI; + + double x1 = 8.9357696627916752158e-01; + double x2 = 3.9576784193148578684e+00; + double x3 = 7.0860510603017726976e+00; + double x11 = 2.280e+02; + double x12 = 2.9519662791675215849e-03; + double x21 = 1.0130e+03; + double x22 = 6.4716931485786837568e-04; + double x31 = 1.8140e+03; + double x32 = 1.1356030177269762362e-04; + + double rc; + double rs; + double y2; + double r; + double y; + double z; + double f; + double si; + double co; + + if ( x < 0.0 ) { + return nan("1"); + } + if ( x == 0.0 ) { + return -1*HUGE_VAL; + } + if ( x == HUGE_VAL ) { + return 0.0; + } + if ( x <= 3.0 ) { + y = x * x; + z = ( _lfortran_dlog(x/x1) * _lfortran_dbesselj0(x) ) * TWO_DIV_PI; + r = bessely0_rational_p1q1( y ); + f = ( x+x1 ) * ( ( x - (x11/256.0) ) - x12 ); + return z + ( f*r ); + } + if ( x <= 5.5 ) { + y = x * x; + z = ( _lfortran_dlog(x/x1) * _lfortran_dbesselj0(x) ) * TWO_DIV_PI; + r = bessely0_rational_p2q2( y ); + f = ( x+x2 ) * ( (x - (x21/256.0)) - x22 ); + return z + ( f*r ); + } + if ( x <= 8.0 ) { + y = x * x; + z = ( _lfortran_dlog(x/x1) * _lfortran_dbesselj0(x) ) * TWO_DIV_PI; + r = bessely0_rational_p3q3( y ); + f = ( x+x3 ) * ( (x - (x31/256.0)) - x32 ); + return z + ( f*r ); + } + y = 8.0 / x; + y2 = y * y; + rc = bessely0_rational_pcqc( y2 ); + rs = bessely0_rational_psqs( y2 ); + f = ONE_DIV_SQRT_PI / sqrt( x ); + + // __sincos(w, &si, &co); + si = sin(x); + co = cos(x); + return f * ( ( rc * (si-co) ) + ( (y*rs) * (si+co) ) ); +} + +LFORTRAN_API float _lfortran_sbessely0( float x ) { + return (float)_lfortran_dbessely0((double)x); +} + // sin ------------------------------------------------------------------------- LFORTRAN_API float _lfortran_ssin(float x) @@ -1276,9 +1969,13 @@ LFORTRAN_API void _lfortran_strcpy(char** x, char *y, int8_t free_target) if (*x) { free((void *)*x); } + *x = (char*) malloc((strlen(y) + 1) * sizeof(char)); + _lfortran_string_init(strlen(y) + 1, *x); + } + if( *x == NULL ) { + *x = (char*) malloc((strlen(y) + 1) * sizeof(char)); + _lfortran_string_init(strlen(y) + 1, *x); } - *x = (char*) malloc((strlen(y) + 1) * sizeof(char)); - _lfortran_string_init(strlen(y) + 1, *x); for (size_t i = 0; i < strlen(*x); i++) { if (i < strlen(y)) { x[0][i] = y[i]; @@ -1583,8 +2280,10 @@ LFORTRAN_API char* _lfortran_str_slice_assign(char* s, char *r, int32_t idx1, in } if (idx1 == idx2 || (step > 0 && (idx1 > idx2 || idx1 >= s_len)) || - (step < 0 && (idx1 < idx2 || idx2 >= s_len-1))) - return ""; + (step < 0 && (idx1 < idx2 || idx2 >= s_len-1))) { + return s; + } + char* dest_char = (char*)malloc(s_len); strcpy(dest_char, s); int s_i = idx1, d_i = 0; @@ -1661,82 +2360,6 @@ LFORTRAN_API void _lfortran_string_init(int size_plus_one, char *s) { // bit ------------------------------------------------------------------------ -LFORTRAN_API int32_t _lfortran_iand32(int32_t x, int32_t y) { - return x & y; -} - -LFORTRAN_API int64_t _lfortran_iand64(int64_t x, int64_t y) { - return x & y; -} - -LFORTRAN_API int32_t _lfortran_not32(int32_t x) { - return ~ x; -} - -LFORTRAN_API int64_t _lfortran_not64(int64_t x) { - return ~ x; -} - -LFORTRAN_API int32_t _lfortran_ior32(int32_t x, int32_t y) { - return x | y; -} - -LFORTRAN_API int64_t _lfortran_ior64(int64_t x, int64_t y) { - return x | y; -} - -LFORTRAN_API int32_t _lfortran_ieor32(int32_t x, int32_t y) { - return x ^ y; -} - -LFORTRAN_API int64_t _lfortran_ieor64(int64_t x, int64_t y) { - return x ^ y; -} - -LFORTRAN_API int32_t _lfortran_ibclr32(int32_t i, int pos) { - return i & ~(1 << pos); -} - -LFORTRAN_API int64_t _lfortran_ibclr64(int64_t i, int pos) { - return i & ~(1LL << pos); -} - -LFORTRAN_API int32_t _lfortran_ibset32(int32_t i, int pos) { - return i | (1 << pos); -} - -LFORTRAN_API int64_t _lfortran_ibset64(int64_t i, int pos) { - return i | (1LL << pos); -} - -LFORTRAN_API int32_t _lfortran_btest32(int32_t i, int pos) { - return i & (1 << pos); -} - -LFORTRAN_API int64_t _lfortran_btest64(int64_t i, int pos) { - return i & (1LL << pos); -} - -LFORTRAN_API int32_t _lfortran_ishft32(int32_t i, int32_t shift) { - if(shift > 0) { - return i << shift; - } else if(shift < 0) { - return i >> abs(shift); - } else { - return i; - } -} - -LFORTRAN_API int64_t _lfortran_ishft64(int64_t i, int64_t shift) { - if(shift > 0) { - return i << shift; - } else if(shift < 0) { - return i >> llabs(shift); - } else { - return i; - } -} - LFORTRAN_API int32_t _lfortran_mvbits32(int32_t from, int32_t frompos, int32_t len, int32_t to, int32_t topos) { uint32_t all_ones = ~0; @@ -1765,46 +2388,6 @@ LFORTRAN_API int64_t _lfortran_mvbits64(int64_t from, int32_t frompos, return (~all_ones & uto) | ufrom; } -LFORTRAN_API int32_t _lfortran_bgt32(int32_t i, int32_t j) { - uint32_t ui = i, uj = j; - return ui > uj; -} - -LFORTRAN_API int32_t _lfortran_bgt64(int64_t i, int64_t j) { - uint64_t ui = i, uj = j; - return ui > uj; -} - -LFORTRAN_API int32_t _lfortran_bge32(int32_t i, int32_t j) { - uint32_t ui = i, uj = j; - return ui >= uj; -} - -LFORTRAN_API int32_t _lfortran_bge64(int64_t i, int64_t j) { - uint64_t ui = i, uj = j; - return ui >= uj; -} - -LFORTRAN_API int32_t _lfortran_ble32(int32_t i, int32_t j) { - uint32_t ui = i, uj = j; - return ui <= uj; -} - -LFORTRAN_API int32_t _lfortran_ble64(int64_t i, int64_t j) { - uint64_t ui = i, uj = j; - return ui <= uj; -} - -LFORTRAN_API int32_t _lfortran_blt32(int32_t i, int32_t j) { - uint32_t ui = i, uj = j; - return ui < uj; -} - -LFORTRAN_API int32_t _lfortran_blt64(int64_t i, int64_t j) { - uint64_t ui = i, uj = j; - return ui < uj; -} - LFORTRAN_API int32_t _lfortran_ibits32(int32_t i, int32_t pos, int32_t len) { uint32_t ui = i; return ((ui << (BITS_32 - pos - len)) >> (BITS_32 - len)); @@ -1825,13 +2408,13 @@ LFORTRAN_API void _lfortran_cpu_time(double *t) { LFORTRAN_API void _lfortran_i32sys_clock( int32_t *count, int32_t *rate, int32_t *max) { -#if defined(_MSC_VER) || defined(__MACH__) +#if defined(_WIN32) *count = - INT_MAX; *rate = 0; *max = 0; #else struct timespec ts; - if(clock_gettime(CLOCK_MONOTONIC, &ts) == -1) { + if(clock_gettime(CLOCK_MONOTONIC, &ts) == 0) { *count = (int32_t)(ts.tv_nsec / 1000000) + ((int32_t)ts.tv_sec * 1000); *rate = 1e3; // milliseconds *max = INT_MAX; @@ -1845,13 +2428,43 @@ LFORTRAN_API void _lfortran_i32sys_clock( LFORTRAN_API void _lfortran_i64sys_clock( uint64_t *count, int64_t *rate, int64_t *max) { -#if defined(_MSC_VER) || defined(__MACH__) +#if defined(_WIN32) + *count = - INT_MAX; + *rate = 0; + *max = 0; +#else + struct timespec ts; + if(clock_gettime(CLOCK_MONOTONIC, &ts) == 0) { + *count = (uint64_t)(ts.tv_nsec) + ((uint64_t)ts.tv_sec * 1000000000); + // FIXME: Rate can be in microseconds or nanoseconds depending on + // resolution of the underlying platform clock. + *rate = 1e9; // nanoseconds + *max = LLONG_MAX; + } else { + *count = - LLONG_MAX; + *rate = 0; + *max = 0; + } +#endif +} + +LFORTRAN_API void _lfortran_i64r64sys_clock( + uint64_t *count, double *rate, int64_t *max) { +double ratev; +int64_t maxv; +if( rate == NULL ) { + rate = &ratev; +} +if( max == NULL ) { + max = &maxv; +} +#if defined(_WIN32) *count = - INT_MAX; *rate = 0; *max = 0; #else struct timespec ts; - if(clock_gettime(CLOCK_MONOTONIC, &ts) == -1) { + if(clock_gettime(CLOCK_MONOTONIC, &ts) == 0) { *count = (uint64_t)(ts.tv_nsec) + ((uint64_t)ts.tv_sec * 1000000000); // FIXME: Rate can be in microseconds or nanoseconds depending on // resolution of the underlying platform clock. @@ -1867,7 +2480,7 @@ LFORTRAN_API void _lfortran_i64sys_clock( LFORTRAN_API double _lfortran_time() { -#if defined(_MSC_VER) +#if defined(_WIN32) FILETIME ft; ULARGE_INTEGER uli; GetSystemTimeAsFileTime(&ft); @@ -1883,14 +2496,12 @@ LFORTRAN_API double _lfortran_time() #endif } -LFORTRAN_API void _lfortran_sp_rand_num(float *x) { - srand(time(0)); - *x = rand() / (float) RAND_MAX; +LFORTRAN_API float _lfortran_sp_rand_num() { + return rand() / (float) RAND_MAX; } -LFORTRAN_API void _lfortran_dp_rand_num(double *x) { - srand(time(0)); - *x = rand() / (double) RAND_MAX; +LFORTRAN_API double _lfortran_dp_rand_num() { + return rand() / (double) RAND_MAX; } LFORTRAN_API int64_t _lpython_open(char *path, char *flags) @@ -2369,7 +2980,7 @@ LFORTRAN_API void _lfortran_read_double(double *p, int32_t unit_num) } } -LFORTRAN_API void _lfortran_formatted_read(int32_t unit_num, int32_t* iostat, char* fmt, int32_t no_of_args, ...) +LFORTRAN_API void _lfortran_formatted_read(int32_t unit_num, int32_t* iostat, int32_t* chunk, char* fmt, int32_t no_of_args, ...) { if (!streql(fmt, "(a)")) { printf("Only (a) supported as fmt currently"); @@ -2402,11 +3013,21 @@ LFORTRAN_API void _lfortran_formatted_read(int32_t unit_num, int32_t* iostat, ch } *iostat = !(fgets(*arg, n+1, filep) == *arg); - (*arg)[strcspn(*arg, "\n")] = 0; + if (streql(*arg, "\n")) { + *iostat = -2; + } + int len = strcspn(*arg, "\n"); + *chunk = len; + (*arg)[len] = 0; va_end(args); } LFORTRAN_API void _lfortran_empty_read(int32_t unit_num, int32_t* iostat) { + if (unit_num == -1) { + // Read from stdin + return; + } + bool unit_file_bin; FILE* fp = get_file_pointer_from_unit(unit_num, &unit_file_bin); if (!fp) { @@ -2444,7 +3065,7 @@ LFORTRAN_API char* _lpython_read(int64_t fd, int64_t n) return c; } -LFORTRAN_API void _lfortran_file_write(int32_t unit_num, const char *format, ...) +LFORTRAN_API void _lfortran_file_write(int32_t unit_num, int32_t* iostat, const char *format, ...) { bool unit_file_bin; FILE* filep = get_file_pointer_from_unit(unit_num, &unit_file_bin); @@ -2461,9 +3082,10 @@ LFORTRAN_API void _lfortran_file_write(int32_t unit_num, const char *format, ... va_end(args); (void)!ftruncate(fileno(filep), ftell(filep)); + *iostat = 0; } -LFORTRAN_API void _lfortran_string_write(char **str, const char *format, ...) { +LFORTRAN_API void _lfortran_string_write(char **str, int32_t* iostat, const char *format, ...) { va_list args; va_start(args, format); char *s = (char *) malloc(strlen(*str)*sizeof(char)); @@ -2471,6 +3093,11 @@ LFORTRAN_API void _lfortran_string_write(char **str, const char *format, ...) { _lfortran_strcpy(str, s, 0); free(s); va_end(args); + *iostat = 0; +} + +LFORTRAN_API void _lfortran_string_read(char *str, char *format, int *i) { + sscanf(str, format, i); } LFORTRAN_API void _lpython_close(int64_t fd) @@ -2536,6 +3163,13 @@ LFORTRAN_API char *_lpython_get_argv(int32_t index) { // << Command line arguments << ------------------------------------------------ +// Initial setup +LFORTRAN_API void _lpython_call_initial_functions(int32_t argc_1, char *argv_1[]) { + _lpython_set_argv(argc_1, argv_1); + _lfortran_init_random_clock(); +} +// << Initial setup << --------------------------------------------------------- + // >> Runtime Stacktrace >> ---------------------------------------------------- #ifdef HAVE_RUNTIME_STACKTRACE #ifdef HAVE_LFORTRAN_UNWIND diff --git a/src/libasr/runtime/lfortran_intrinsics.h b/src/libasr/runtime/lfortran_intrinsics.h index 7efaa10..7215573 100644 --- a/src/libasr/runtime/lfortran_intrinsics.h +++ b/src/libasr/runtime/lfortran_intrinsics.h @@ -99,14 +99,14 @@ LFORTRAN_API void _lfortran_complex_aimag_32(struct _lfortran_complex_32 *x, flo LFORTRAN_API void _lfortran_complex_aimag_64(struct _lfortran_complex_64 *x, double *res); LFORTRAN_API float_complex_t _lfortran_csqrt(float_complex_t x); LFORTRAN_API double_complex_t _lfortran_zsqrt(double_complex_t x); -LFORTRAN_API float _lfortran_caimag(float_complex_t x); -LFORTRAN_API double _lfortran_zaimag(double_complex_t x); LFORTRAN_API float _lfortran_sexp(float x); LFORTRAN_API double _lfortran_dexp(double x); LFORTRAN_API float_complex_t _lfortran_cexp(float_complex_t x); LFORTRAN_API double_complex_t _lfortran_zexp(double_complex_t x); LFORTRAN_API float _lfortran_slog(float x); LFORTRAN_API double _lfortran_dlog(double x); +LFORTRAN_API bool _lfortran_rsp_is_nan(float x); +LFORTRAN_API bool _lfortran_rdp_is_nan(double x); LFORTRAN_API float_complex_t _lfortran_clog(float_complex_t x); LFORTRAN_API double_complex_t _lfortran_zlog(double_complex_t x); LFORTRAN_API float _lfortran_serf(float x); @@ -214,34 +214,10 @@ LFORTRAN_API char* _lfortran_str_slice(char* s, int32_t idx1, int32_t idx2, int3 bool idx1_present, bool idx2_present); LFORTRAN_API char* _lfortran_str_slice_assign(char* s, char *r, int32_t idx1, int32_t idx2, int32_t step, bool idx1_present, bool idx2_present); -LFORTRAN_API int32_t _lfortran_iand32(int32_t x, int32_t y); -LFORTRAN_API int64_t _lfortran_iand64(int64_t x, int64_t y); -LFORTRAN_API int32_t _lfortran_not32(int32_t x); -LFORTRAN_API int64_t _lfortran_not64(int64_t x); -LFORTRAN_API int32_t _lfortran_ior32(int32_t x, int32_t y); -LFORTRAN_API int64_t _lfortran_ior64(int64_t x, int64_t y); -LFORTRAN_API int32_t _lfortran_ieor32(int32_t x, int32_t y); -LFORTRAN_API int64_t _lfortran_ieor64(int64_t x, int64_t y); -LFORTRAN_API int32_t _lfortran_ibclr32(int32_t i, int pos); -LFORTRAN_API int64_t _lfortran_ibclr64(int64_t i, int pos); -LFORTRAN_API int32_t _lfortran_ibset32(int32_t i, int pos); -LFORTRAN_API int64_t _lfortran_ibset64(int64_t i, int pos); -LFORTRAN_API int32_t _lfortran_btest32(int32_t i, int pos); -LFORTRAN_API int64_t _lfortran_btest64(int64_t i, int pos); -LFORTRAN_API int32_t _lfortran_ishft32(int32_t i, int32_t shift); -LFORTRAN_API int64_t _lfortran_ishft64(int64_t i, int64_t shift); LFORTRAN_API int32_t _lfortran_mvbits32(int32_t from, int32_t frompos, int32_t len, int32_t to, int32_t topos); LFORTRAN_API int64_t _lfortran_mvbits64(int64_t from, int32_t frompos, int32_t len, int64_t to, int32_t topos); -LFORTRAN_API int32_t _lfortran_bgt32(int32_t i, int32_t j); -LFORTRAN_API int32_t _lfortran_bgt64(int64_t i, int64_t j); -LFORTRAN_API int32_t _lfortran_bge32(int32_t i, int32_t j); -LFORTRAN_API int32_t _lfortran_bge64(int64_t i, int64_t j); -LFORTRAN_API int32_t _lfortran_ble32(int32_t i, int32_t j); -LFORTRAN_API int32_t _lfortran_ble64(int64_t i, int64_t j); -LFORTRAN_API int32_t _lfortran_blt32(int32_t i, int32_t j); -LFORTRAN_API int32_t _lfortran_blt64(int64_t i, int64_t j); LFORTRAN_API int32_t _lfortran_ibits32(int32_t i, int32_t pos, int32_t len); LFORTRAN_API int64_t _lfortran_ibits64(int64_t i, int32_t pos, int32_t len); LFORTRAN_API void _lfortran_cpu_time(double *t); @@ -249,14 +225,16 @@ LFORTRAN_API void _lfortran_i32sys_clock( int32_t *count, int32_t *rate, int32_t *max); LFORTRAN_API void _lfortran_i64sys_clock( uint64_t *count, int64_t *rate, int64_t *max); +LFORTRAN_API void _lfortran_i64r64sys_clock( + uint64_t *count, double *rate, int64_t *max); LFORTRAN_API double _lfortran_time(); -LFORTRAN_API void _lfortran_sp_rand_num(float *x); -LFORTRAN_API void _lfortran_dp_rand_num(double *x); +LFORTRAN_API float _lfortran_sp_rand_num(); +LFORTRAN_API double _lfortran_dp_rand_num(); LFORTRAN_API int64_t _lpython_open(char *path, char *flags); LFORTRAN_API int64_t _lfortran_open(int32_t unit_num, char *f_name, char *status, char* form); LFORTRAN_API void _lfortran_flush(int32_t unit_num); LFORTRAN_API void _lfortran_inquire(char *f_name, bool *exists, int32_t unit_num, bool *opened); -LFORTRAN_API void _lfortran_formatted_read(int32_t unit_num, int32_t* iostat, char* fmt, int32_t no_of_args, ...); +LFORTRAN_API void _lfortran_formatted_read(int32_t unit_num, int32_t* iostat, int32_t* chunk, char* fmt, int32_t no_of_args, ...); LFORTRAN_API char* _lpython_read(int64_t fd, int64_t n); LFORTRAN_API void _lfortran_read_int32(int32_t *p, int32_t unit_num); LFORTRAN_API void _lfortran_read_int64(int64_t *p, int32_t unit_num); @@ -266,8 +244,9 @@ LFORTRAN_API void _lfortran_read_float(float *p, int32_t unit_num); LFORTRAN_API void _lfortran_read_array_float(float *p, int array_size, int32_t unit_num); LFORTRAN_API void _lfortran_read_array_double(double *p, int array_size, int32_t unit_num); LFORTRAN_API void _lfortran_read_char(char **p, int32_t unit_num); -LFORTRAN_API void _lfortran_string_write(char **str, const char *format, ...); -LFORTRAN_API void _lfortran_file_write(int32_t unit_num, const char *format, ...); +LFORTRAN_API void _lfortran_string_write(char **str, int32_t* iostat, const char *format, ...); +LFORTRAN_API void _lfortran_file_write(int32_t unit_num, int32_t* iostat, const char *format, ...); +LFORTRAN_API void _lfortran_string_read(char *str, char *format, int *i); LFORTRAN_API void _lfortran_empty_read(int32_t unit_num, int32_t* iostat); LFORTRAN_API void _lpython_close(int64_t fd); LFORTRAN_API void _lfortran_close(int32_t unit_num); @@ -277,6 +256,7 @@ LFORTRAN_API int32_t _lfortran_all(bool *mask, int32_t n); LFORTRAN_API void _lpython_set_argv(int32_t argc_1, char *argv_1[]); LFORTRAN_API int32_t _lpython_get_argc(); LFORTRAN_API char *_lpython_get_argv(int32_t index); +LFORTRAN_API void _lpython_call_initial_functions(int32_t argc_1, char *argv_1[]); LFORTRAN_API void print_stacktrace_addresses(char *filename, bool use_colors); LFORTRAN_API char *_lfortran_get_env_variable(char *name); LFORTRAN_API int _lfortran_exec_command(char *cmd); diff --git a/src/libasr/serialization.cpp b/src/libasr/serialization.cpp index 3c0bc96..12967cd 100644 --- a/src/libasr/serialization.cpp +++ b/src/libasr/serialization.cpp @@ -243,6 +243,28 @@ class FixParentSymtabVisitor : public BaseWalkVisitor current_symtab = parent_symtab; } + void visit_Requirement(const Requirement_t &x) { + SymbolTable *parent_symtab = current_symtab; + current_symtab = x.m_symtab; + x.m_symtab->parent = parent_symtab; + x.m_symtab->asr_owner = (asr_t*)&x; + for (auto &a : x.m_symtab->get_scope()) { + this->visit_symbol(*a.second); + } + current_symtab = parent_symtab; + } + + void visit_Template(const Template_t &x) { + SymbolTable *parent_symtab = current_symtab; + current_symtab = x.m_symtab; + x.m_symtab->parent = parent_symtab; + x.m_symtab->asr_owner = (asr_t*)&x; + for (auto &a : x.m_symtab->get_scope()) { + this->visit_symbol(*a.second); + } + current_symtab = parent_symtab; + } + }; class FixExternalSymbolsVisitor : public BaseWalkVisitor @@ -343,6 +365,10 @@ class FixExternalSymbolsVisitor : public BaseWalkVisitor(m_sym); sym = m->m_symtab->find_scoped_symbol(original_name, x.n_scope_names, x.m_scope_names); + } else if( ASR::is_a(*m_sym) ) { + Function_t *m = down_cast(m_sym); + sym = m->m_symtab->find_scoped_symbol(original_name, + x.n_scope_names, x.m_scope_names); } if (sym) { // FIXME: this is a hack, we need to pass in a non-const `x`. diff --git a/src/libasr/stacktrace.cpp b/src/libasr/stacktrace.cpp index c356e4b..d5cab74 100644 --- a/src/libasr/stacktrace.cpp +++ b/src/libasr/stacktrace.cpp @@ -36,6 +36,7 @@ #ifdef HAVE_LFORTRAN_MACHO # include +# include // PATH_MAX #endif #ifdef HAVE_LFORTRAN_BFD diff --git a/src/libasr/string_utils.cpp b/src/libasr/string_utils.cpp index b1b1e92..bd496d0 100644 --- a/src/libasr/string_utils.cpp +++ b/src/libasr/string_utils.cpp @@ -192,6 +192,9 @@ char* str_unescape_c(Allocator &al, LCompilers::Str &s) { } else if (s[idx] == '\\' && s[idx+1] == 'v') { x += "\v"; idx++; + } else if (s[idx] == '\\' && s[idx + 1] == 'f') { + x += "\f"; + idx++; } else if (s[idx] == '\\' && s[idx+1] == '\\') { x += "\\"; idx++; diff --git a/src/libasr/utils.h b/src/libasr/utils.h index 50b5929..4a51127 100644 --- a/src/libasr/utils.h +++ b/src/libasr/utils.h @@ -28,6 +28,8 @@ struct PassOptions { std::filesystem::path mod_files_dir; std::vector include_dirs; + int default_integer_kind = 4; + std::string run_fun; // for global_stmts pass // TODO: Convert to std::filesystem::path (also change find_and_load_module()) std::string runtime_library_dir; @@ -55,6 +57,7 @@ struct PassOptions { bool visualize = false; bool tree = false; bool with_intrinsic_mods = false; + bool c_mangling = false; }; struct CompilerOptions { diff --git a/tests/reference/asr-array_01-080be05.json b/tests/reference/asr-array_01-080be05.json index b5fe19b..a5c78c2 100644 --- a/tests/reference/asr-array_01-080be05.json +++ b/tests/reference/asr-array_01-080be05.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-array_01-080be05.stdout", - "stdout_hash": "337b11bab91bf64e841d76a62768573e77f7b5b2db440edef9ad10e7", + "stdout_hash": "a278a5b349fcb27e56da16acb92d7fb7762161bea01c804292663f3c", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-array_01-080be05.stdout b/tests/reference/asr-array_01-080be05.stdout index 7ec757c..64b5452 100644 --- a/tests/reference/asr-array_01-080be05.stdout +++ b/tests/reference/asr-array_01-080be05.stdout @@ -183,7 +183,7 @@ ) [] [] - [(= + [(Assignment (Var 2 arr1d) (ArrayConstant [(IntegerConstant 1 (Integer 4)) @@ -201,7 +201,7 @@ ) () ) - (= + (Assignment (Var 2 arr2d) (ArrayReshape (ArrayConstant @@ -274,17 +274,17 @@ ) () ) - (= + (Assignment (Var 2 sum1d) (IntegerConstant 0 (Integer 4)) () ) - (= + (Assignment (Var 2 sum2d) (IntegerConstant 0 (Integer 4)) () ) - (= + (Assignment (Var 2 i) (IntegerConstant 0 (Integer 4)) () @@ -298,7 +298,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 sum1d) (IntegerBinOp (Var 2 sum1d) @@ -317,7 +317,7 @@ ) () ) - (= + (Assignment (Var 2 i) (IntegerBinOp (Var 2 i) @@ -328,8 +328,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 j) (IntegerConstant 0 (Integer 4)) () @@ -343,7 +344,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 k) (IntegerConstant 0 (Integer 4)) () @@ -357,7 +358,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 l) (IntegerConstant 0 (Integer 4)) () @@ -371,7 +372,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 sum2d) (IntegerBinOp (Var 2 sum2d) @@ -396,7 +397,7 @@ ) () ) - (= + (Assignment (Var 2 l) (IntegerBinOp (Var 2 l) @@ -407,8 +408,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 k) (IntegerBinOp (Var 2 k) @@ -419,8 +421,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 j) (IntegerBinOp (Var 2 j) @@ -431,6 +434,7 @@ ) () )] + [] ) (Print [(Var 2 sum1d) @@ -438,7 +442,7 @@ () () ) - (= + (Assignment (Var 2 __return_var) (IntegerConstant 0 (Integer 4)) () @@ -474,7 +478,7 @@ }) main_program [main] - [(= + [(Assignment (Var 3 exit_code) (FunctionCall 1 main diff --git a/tests/reference/asr-array_02-ec70729.json b/tests/reference/asr-array_02-ec70729.json index dd19f18..f025b9f 100644 --- a/tests/reference/asr-array_02-ec70729.json +++ b/tests/reference/asr-array_02-ec70729.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-array_02-ec70729.stdout", - "stdout_hash": "136152ef3c7f0b28b2d52e7b2698c0f8b0b5072ff6baeb446c70c0d5", + "stdout_hash": "d921e30af93bdc79cf404be91285a2dd80d501ce3e9e1bc46b4347b9", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-array_02-ec70729.stdout b/tests/reference/asr-array_02-ec70729.stdout index cfd2347..002fa20 100644 --- a/tests/reference/asr-array_02-ec70729.stdout +++ b/tests/reference/asr-array_02-ec70729.stdout @@ -57,7 +57,7 @@ ) [matmul_test] [] - [(= + [(Assignment (Var 3 sum) (FunctionCall 1 matmul_test @@ -81,7 +81,7 @@ () () ) - (= + (Assignment (Var 3 __return_var) (IntegerConstant 0 (Integer 4)) () @@ -117,7 +117,7 @@ }) main_program [main] - [(= + [(Assignment (Var 4 exit_code) (FunctionCall 1 main @@ -413,7 +413,7 @@ [(Var 2 m) (Var 2 n) (Var 2 nums)] - [(= + [(Assignment (Var 2 num) (IntegerConstant 0 (Integer 4)) () @@ -427,7 +427,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 i) (IntegerConstant 0 (Integer 4)) () @@ -441,7 +441,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 j) (IntegerConstant 0 (Integer 4)) () @@ -455,7 +455,7 @@ (Logical 4) () ) - [(= + [(Assignment (ArrayItem (Var 2 arr2d) [(() @@ -502,7 +502,7 @@ ) () ) - (= + (Assignment (Var 2 j) (IntegerBinOp (Var 2 j) @@ -513,8 +513,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 i) (IntegerBinOp (Var 2 i) @@ -525,8 +526,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 num) (IntegerBinOp (Var 2 num) @@ -537,8 +539,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 k) (IntegerConstant 0 (Integer 4)) () @@ -552,7 +555,7 @@ (Logical 4) () ) - [(= + [(Assignment (ArrayItem (Var 2 arr1d) [(() @@ -581,7 +584,7 @@ ) () ) - (= + (Assignment (Var 2 k) (IntegerBinOp (Var 2 k) @@ -592,8 +595,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 sum) (Cast (RealConstant @@ -609,7 +613,7 @@ ) () ) - (= + (Assignment (Var 2 num1) (IntegerConstant 0 (Integer 4)) () @@ -623,7 +627,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 i1) (IntegerConstant 0 (Integer 4)) () @@ -637,7 +641,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 output) (Cast (RealConstant @@ -653,7 +657,7 @@ ) () ) - (= + (Assignment (Var 2 j1) (IntegerConstant 0 (Integer 4)) () @@ -667,7 +671,7 @@ (Logical 4) () ) - [(= + [(Assignment (Var 2 output) (RealBinOp (Var 2 output) @@ -706,7 +710,7 @@ ) () ) - (= + (Assignment (Var 2 j1) (IntegerBinOp (Var 2 j1) @@ -717,8 +721,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 sum) (RealBinOp (Var 2 sum) @@ -729,7 +734,7 @@ ) () ) - (= + (Assignment (Var 2 i1) (IntegerBinOp (Var 2 i1) @@ -740,8 +745,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 num1) (IntegerBinOp (Var 2 num1) @@ -752,8 +758,9 @@ ) () )] + [] ) - (= + (Assignment (Var 2 __return_var) (Var 2 sum) () diff --git a/tests/reference/asr-array_04-f95b8eb.json b/tests/reference/asr-array_04-f95b8eb.json index 2f6b381..0f46638 100644 --- a/tests/reference/asr-array_04-f95b8eb.json +++ b/tests/reference/asr-array_04-f95b8eb.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-array_04-f95b8eb.stdout", - "stdout_hash": "b72419a0a8bd62f822377669e6e98ca64a95400f6c7ce7b7ad33a68a", + "stdout_hash": "b63d1dcba8f9628e897f64e5ed5f57df9da1c398131da94d0a722bee", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-array_04-f95b8eb.stdout b/tests/reference/asr-array_04-f95b8eb.stdout index 0867617..81fd921 100644 --- a/tests/reference/asr-array_04-f95b8eb.stdout +++ b/tests/reference/asr-array_04-f95b8eb.stdout @@ -145,7 +145,7 @@ () () ) - (= + (Assignment (Var 2 arr1) (ArrayReshape (ArrayConstant @@ -194,7 +194,7 @@ RowMajor ) (ArrayPhysicalCast - (ArrayConstant + (ArrayConstructor [(ArraySize (Var 2 arr1) (IntegerConstant 1 (Integer 4)) @@ -213,6 +213,7 @@ (IntegerConstant 2 (Integer 4)))] FixedSizeArray ) + () RowMajor ) FixedSizeArray @@ -247,7 +248,7 @@ () () ) - (= + (Assignment (Var 2 arr2) (ArrayConstant [(RealConstant @@ -272,7 +273,7 @@ ) () ) - (= + (Assignment (Var 2 res_) (ArrayConstant [(RealConstant @@ -307,7 +308,7 @@ () () ) - (= + (Assignment (Var 2 res) (RealBinOp (ArraySection @@ -399,7 +400,7 @@ (IntrinsicArrayFunction Any [(RealCompare - (IntrinsicScalarFunction + (IntrinsicElementalFunction Abs [(RealBinOp (Var 2 res) @@ -430,7 +431,7 @@ ) (IntrinsicArrayFunction Shape - [(IntrinsicScalarFunction + [(IntrinsicElementalFunction Abs [(RealBinOp (Var 2 res) @@ -452,8 +453,7 @@ DescriptorArray ) () - ) - (IntegerConstant 4 (Integer 4))] + )] 0 (Array (Integer 4) @@ -488,7 +488,7 @@ )] [] ) - (= + (Assignment (Var 2 __return_var) (IntegerConstant 0 (Integer 4)) () @@ -524,7 +524,7 @@ }) main_program [main] - [(= + [(Assignment (Var 3 exit_code) (FunctionCall 1 main diff --git a/tests/reference/asr-expr2-dda5523.json b/tests/reference/asr-expr2-dda5523.json index 13ef6da..95b4463 100644 --- a/tests/reference/asr-expr2-dda5523.json +++ b/tests/reference/asr-expr2-dda5523.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-expr2-dda5523.stdout", - "stdout_hash": "3ddf35a568bead6e0f2947e9ed63f2590c39070d9d6aaa8018b7a107", + "stdout_hash": "1e95da0bf9445357bbc5cb0d0d3eef514631cf16a74c8d5f3b5f80ef", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-expr2-dda5523.stdout b/tests/reference/asr-expr2-dda5523.stdout index 94a4ee7..07b51d7 100644 --- a/tests/reference/asr-expr2-dda5523.stdout +++ b/tests/reference/asr-expr2-dda5523.stdout @@ -57,7 +57,7 @@ ) [] [] - [(= + [(Assignment (Var 2 x) (IntegerBinOp (IntegerBinOp @@ -79,7 +79,7 @@ () () ) - (= + (Assignment (Var 2 __return_var) (IntegerConstant 0 (Integer 4)) () @@ -115,7 +115,7 @@ }) main_program [main] - [(= + [(Assignment (Var 3 exit_code) (FunctionCall 1 main diff --git a/tests/reference/asr-test-5bdab26.json b/tests/reference/asr-test-5bdab26.json index 7b1a2c6..d1ce613 100644 --- a/tests/reference/asr-test-5bdab26.json +++ b/tests/reference/asr-test-5bdab26.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "asr-test-5bdab26.stdout", - "stdout_hash": "f31a3fab00e8917eaae30983c0ed97a62e13a54b839a6439e6e7b225", + "stdout_hash": "1bc70975fa9dbd6ac3d26f7397f90eab990cfcf0c31fef3597b7257a", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/asr-test-5bdab26.stdout b/tests/reference/asr-test-5bdab26.stdout index dca78aa..cba4be6 100644 --- a/tests/reference/asr-test-5bdab26.stdout +++ b/tests/reference/asr-test-5bdab26.stdout @@ -73,7 +73,7 @@ ) [] [(Var 2 x)] - [(= + [(Assignment (Var 2 result) (IntegerBinOp (Var 2 x) @@ -84,7 +84,7 @@ ) () ) - (= + (Assignment (Var 2 __return_var) (Var 2 result) () diff --git a/tests/reference/fortran-expr2-98fb1e2.json b/tests/reference/fortran-expr2-98fb1e2.json index 1c68117..85de0b1 100644 --- a/tests/reference/fortran-expr2-98fb1e2.json +++ b/tests/reference/fortran-expr2-98fb1e2.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "fortran-expr2-98fb1e2.stdout", - "stdout_hash": "b8f3c8cc35ee0c5361cfcfa8863d24bb92422816362a63be297b1122", + "stdout_hash": "79877dd33c7f4304ceefe7e697e1d6840b3e72e9b5e84cf470b747c9", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/fortran-expr2-98fb1e2.stdout b/tests/reference/fortran-expr2-98fb1e2.stdout index b67115e..ebef919 100644 --- a/tests/reference/fortran-expr2-98fb1e2.stdout +++ b/tests/reference/fortran-expr2-98fb1e2.stdout @@ -1,3 +1,10 @@ +program main_program +implicit none +integer(4) :: exit_code +exit_code = main() + +contains + integer(4) function main() result(__return_var) integer(4) :: x x = (2 + 3)*5 @@ -5,8 +12,5 @@ integer(4) function main() result(__return_var) __return_var = 0 return end function main -program main_program -implicit none -integer(4) :: exit_code -exit_code = main() + end program main_program diff --git a/tests/reference/fortran-test-a055f99.json b/tests/reference/fortran-test-a055f99.json index 7fc0180..a5717cc 100644 --- a/tests/reference/fortran-test-a055f99.json +++ b/tests/reference/fortran-test-a055f99.json @@ -5,8 +5,8 @@ "infile_hash": "9e5ef4c37b7e9e1f13f0082ce65459c1e596430887537eb8fd656b77", "outfile": null, "outfile_hash": null, - "stdout": "fortran-test-a055f99.stdout", - "stdout_hash": "2f2dc8c461a0bfd018dacc50ff66fb073fa6c3df9ddaac3d3a3f723c", + "stdout": null, + "stdout_hash": null, "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/llvm-expr2-94e7c35.json b/tests/reference/llvm-expr2-94e7c35.json index 354e8e1..8a50bd4 100644 --- a/tests/reference/llvm-expr2-94e7c35.json +++ b/tests/reference/llvm-expr2-94e7c35.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "llvm-expr2-94e7c35.stdout", - "stdout_hash": "c4fee5fbea28a7bc420b69eef175e602dac950734fe20cdb001500ee", + "stdout_hash": "f84e616de338d7da42865b2bea66bed96a8bbb448f7d8f7eff385f09", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/llvm-expr2-94e7c35.stdout b/tests/reference/llvm-expr2-94e7c35.stdout index 0313d9b..fe1ae3d 100644 --- a/tests/reference/llvm-expr2-94e7c35.stdout +++ b/tests/reference/llvm-expr2-94e7c35.stdout @@ -27,11 +27,11 @@ declare void @_lfortran_printf(i8*, ...) define i32 @main(i32 %0, i8** %1) { .entry: - call void @_lpython_set_argv(i32 %0, i8** %1) + call void @_lpython_call_initial_functions(i32 %0, i8** %1) %exit_code = alloca i32, align 4 %2 = call i32 @_xx_lcompilers_changed_main_xx() store i32 %2, i32* %exit_code, align 4 ret i32 0 } -declare void @_lpython_set_argv(i32, i8**) +declare void @_lpython_call_initial_functions(i32, i8**) diff --git a/tests/reference/llvm-test-63615c0.json b/tests/reference/llvm-test-63615c0.json index 8f33657..4d6588c 100644 --- a/tests/reference/llvm-test-63615c0.json +++ b/tests/reference/llvm-test-63615c0.json @@ -6,7 +6,7 @@ "outfile": null, "outfile_hash": null, "stdout": "llvm-test-63615c0.stdout", - "stdout_hash": "16fa5cc945a4f616003132a63f4c6a9efdd477e5dead527d20ab69d1", + "stdout_hash": "693feb9b391bb484b8222d405bef48b74ca2ab345a8bb0bfcf1f78f5", "stderr": null, "stderr_hash": null, "returncode": 0 diff --git a/tests/reference/llvm-test-63615c0.stdout b/tests/reference/llvm-test-63615c0.stdout index 3041ad4..97e15b2 100644 --- a/tests/reference/llvm-test-63615c0.stdout +++ b/tests/reference/llvm-test-63615c0.stdout @@ -6,7 +6,7 @@ define i32 @f(i32* %x) { %__return_var = alloca i32, align 4 %result = alloca i32, align 4 %0 = load i32, i32* %x, align 4 - %1 = udiv i32 %0, 42 + %1 = sdiv i32 %0, 42 store i32 %1, i32* %result, align 4 %2 = load i32, i32* %result, align 4 store i32 %2, i32* %__return_var, align 4