feat: implement random init subroutine (lfortran#4454)

integration_tests/CMakeLists.txt

@@ -360,6 +360,7 @@ RUN(NAME subroutines_07 LABELS gfortran)
 RUN(NAME subroutines_08 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc wasm)
 RUN(NAME subroutines_09 LABELS gfortran)
 RUN(NAME subroutines_10 LABELS gfortran)
+RUN(NAME subroutines_11 LABELS gfortran)
 
 RUN(NAME functions_01 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc cpp x86 wasm)
 RUN(NAME functions_02 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc wasm)

integration_tests/subroutines_11.f90

@@ -0,0 +1,16 @@
+program test
+    implicit none
+
+    real :: x(1, 3)
+    x = 0
+    call random_init(.true., .true.)
+    call random_number(x(1, 2))
+    call random_init(.true., .true.)
+    call random_number(x(1, 3))
+    print *, x
+
+    if (abs(x(1, 1) - 0.0) > 1e-5) error stop
+    if (abs(x(1, 2) - 0.0) < 1e-8) error stop
+    ! The two values must be the same, due to `random_init()` above
+    if (x(1, 2) /= x(1, 3)) error stop
+end program

src/lfortran/semantics/ast_common_visitor.h

@@ -849,6 +849,7 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
         {"dshiftl", {IntrinsicSignature({"i", "j", "shift"}, 3, 3)}},
         {"dshiftr", {IntrinsicSignature({"i", "j", "shift"}, 3, 3)}},
         {"random_number", {IntrinsicSignature({"r"}, 1, 1)}},
+        {"random_init", {IntrinsicSignature({"repeatable", "image"}, 2, 2)}},
         {"mvbits", {IntrinsicSignature({"from", "frompos", "len", "to", "topos"}, 5, 5)}},
         {"modulo", {IntrinsicSignature({"a", "p"}, 2, 2)}},
         {"bessel_jn", {IntrinsicSignature({"n", "x"}, 2, 2)}},

src/libasr/codegen/asr_to_fortran.cpp

@@ -1248,6 +1248,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor<ASRToFortranVisitor>
         out = "call ";
         switch ( x.m_intrinsic_id ) {
             SET_INTRINSIC_SUBROUTINE_NAME(RandomNumber, "random_number");
+            SET_INTRINSIC_SUBROUTINE_NAME(RandomInit, "random_init");
             default : {
                 throw LCompilersException("IntrinsicImpureSubroutine: `"
                     + ASRUtils::get_intrinsic_name(x.m_intrinsic_id)

src/libasr/pass/intrinsic_subroutine_registry.h

@@ -20,6 +20,7 @@ namespace ASRUtils {
 inline std::string get_intrinsic_subroutine_name(int x) {
     switch (x) {
         INTRINSIC_SUBROUTINE_NAME_CASE(RandomNumber)
+        INTRINSIC_SUBROUTINE_NAME_CASE(RandomInit)
         default : {
             throw LCompilersException("pickle: intrinsic_id not implemented");
         }
@@ -35,17 +36,22 @@ namespace IntrinsicImpureSubroutineRegistry {
                    verify_subroutine>>& intrinsic_subroutine_by_id_db = {
         {static_cast<int64_t>(IntrinsicImpureSubroutines::RandomNumber),
             {&RandomNumber::instantiate_RandomNumber, &RandomNumber::verify_args}},
+        {static_cast<int64_t>(IntrinsicImpureSubroutines::RandomInit),
+            {&RandomInit::instantiate_RandomInit, &RandomInit::verify_args}},
     };
 
     static const std::map<int64_t, std::string>& intrinsic_subroutine_id_to_name = {
         {static_cast<int64_t>(IntrinsicImpureSubroutines::RandomNumber),
             "random_number"},
+        {static_cast<int64_t>(IntrinsicImpureSubroutines::RandomInit),
+            "random_init"},
     };
 
 
     static const std::map<std::string,
         create_intrinsic_subroutine>& intrinsic_subroutine_by_name_db = {
                 {"random_number", &RandomNumber::create_RandomNumber},
+                {"random_init", &RandomInit::create_RandomInit},
     };
 
     static inline bool is_intrinsic_subroutine(const std::string& name) {

src/libasr/pass/intrinsic_subroutines.h

@@ -20,6 +20,7 @@ the code size.
 
 enum class IntrinsicImpureSubroutines : int64_t {
     RandomNumber,
+    RandomInit,
     // ...
 };
 
@@ -39,6 +40,56 @@ typedef void (*verify_subroutine)(
 
 typedef ASR::expr_t* (*get_initial_value_sub)(Allocator&, ASR::ttype_t*);
 
+namespace RandomInit {
+
+    static inline void verify_args(const ASR::IntrinsicImpureSubroutine_t& x, diag::Diagnostics& diagnostics) {
+        if (x.n_args == 2) {
+            ASRUtils::require_impl(x.m_overload_id == 0, "Overload Id for random_init expected to be 0, found " + std::to_string(x.m_overload_id), x.base.base.loc, diagnostics);
+            ASRUtils::require_impl(ASRUtils::is_logical(*ASRUtils::expr_type(x.m_args[0])), "First argument must be of logical type", x.base.base.loc, diagnostics);
+            ASRUtils::require_impl(ASRUtils::is_logical(*ASRUtils::expr_type(x.m_args[1])), "Second argument must be of logical type", x.base.base.loc, diagnostics);
+        } else {
+            ASRUtils::require_impl(false, "Unexpected number of args, random_init takes 2 arguments, found " + std::to_string(x.n_args), x.base.base.loc, diagnostics);
+        }
+    }
+
+    static inline ASR::asr_t* create_RandomInit(Allocator& al, const Location& loc, Vec<ASR::expr_t*>& args, diag::Diagnostics& /*diag*/) {
+        Vec<ASR::expr_t*> m_args; m_args.reserve(al, 2);
+        m_args.push_back(al, args[0]);
+        m_args.push_back(al, args[1]);
+        return ASR::make_IntrinsicImpureSubroutine_t(al, loc, static_cast<int64_t>(IntrinsicImpureSubroutines::RandomInit), m_args.p, m_args.n, 0);
+    }
+
+    static inline ASR::stmt_t* instantiate_RandomInit(Allocator &al, const Location &loc,
+            SymbolTable *scope, Vec<ASR::ttype_t*>& arg_types,
+            Vec<ASR::call_arg_t>& new_args, int64_t /*overload_id*/) {
+
+        std::string c_func_name = "_lfortran_random_init";
+        std::string new_name = "_lcompilers_random_init_";
+
+        declare_basic_variables(new_name);
+        fill_func_arg_sub("repeatable", arg_types[0], InOut);
+        fill_func_arg_sub("image_distinct", arg_types[1], InOut);
+        SymbolTable *fn_symtab_1 = al.make_new<SymbolTable>(fn_symtab);
+        Vec<ASR::expr_t*> 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<ASR::stmt_t*> 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<ASR::expr_t*> call_args; call_args.reserve(al, 0);
+        body.push_back(al, b.Assignment(args[0], b.Call(s, call_args, arg_types[0])));
+        body.push_back(al, b.Assignment(args[1], b.Call(s, call_args, arg_types[1])));
+        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 RandomInit
+
 namespace RandomNumber {
 
     static inline void verify_args(const ASR::IntrinsicImpureSubroutine_t& x, diag::Diagnostics& diagnostics) {

src/libasr/runtime/lfortran_intrinsics.c

@@ -2200,6 +2200,16 @@ LFORTRAN_API double _lfortran_dp_rand_num() {
     return rand() / (double) RAND_MAX;
 }
 
+
+LFORTRAN_API bool _lfortran_random_init(bool repeatable, bool image_distinct) {
+    if (repeatable) {
+            srand(0);
+    } else {
+        srand(time(NULL));
+    }
+    return false;
+}
+
 LFORTRAN_API int64_t _lpython_open(char *path, char *flags)
 {
     FILE *fd;