Merge branch 'dflt_intent2' into 'master'

Implement default intent

Closes lcompilers#324

See merge request lfortran/lfortran!874

grammar/ASR.asdl

@@ -94,7 +94,7 @@ symbol
 
 storage_type = Default | Save | Parameter
 access = Public | Private
-intent = Local | In | Out | InOut | ReturnVar
+intent = Local | In | Out | InOut | ReturnVar | Unspecified
 
 -- # Documentation for the ABI type
 

integration_tests/CMakeLists.txt

@@ -250,3 +250,5 @@ RUN(NAME string3 LABELS gfortran llvm)
 
 RUN(NAME nested_01 LABELS gfortran llvm)
 RUN(NAME nested_02 LABELS gfortran llvm)
+
+RUN(NAME intent_01 LABELS gfortran llvm)

integration_tests/intent_01.f90

@@ -0,0 +1,25 @@
+module dflt_intent
+
+contains
+
+subroutine foo(c, d)
+real :: c, d, e, g
+e = f(c)
+g = f(d)
+
+contains
+
+real function f(x)
+real, intent(in) :: x
+f = 2*x
+print *, f
+end function f
+
+end subroutine foo
+
+end module
+
+program main
+  use dflt_intent
+  call foo(0.0, 2.0)
+end program

src/lfortran/asr_utils.h

@@ -133,10 +133,11 @@ const ASR::intentType intent_in   =ASR::intentType::In; // dummy argument, inten
 const ASR::intentType intent_out  =ASR::intentType::Out; // dummy argument, intent(out)
 const ASR::intentType intent_inout=ASR::intentType::InOut; // dummy argument, intent(inout)
 const ASR::intentType intent_return_var=ASR::intentType::ReturnVar; // return variable of a function
+const ASR::intentType intent_unspecified=ASR::intentType::Unspecified; // dummy argument, ambiguous intent
 
 static inline bool is_arg_dummy(int intent) {
     return intent == intent_in || intent == intent_out
-        || intent == intent_inout;
+        || intent == intent_inout || intent == intent_unspecified;
 }
 
 static inline bool main_program_present(const ASR::TranslationUnit_t &unit)

src/lfortran/semantics/ast_to_asr.cpp

@@ -484,6 +484,7 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
     std::map<std::string, ASR::accessType> assgnd_access;
     Vec<char*> current_module_dependencies;
     bool in_module=false;
+    std::vector<std::string> current_procedure_args;
 
     SymbolTableVisitor(Allocator &al, SymbolTable *symbol_table)
         : al{al}, current_scope{symbol_table} { }
@@ -579,6 +580,11 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
         ASR::accessType s_access = dflt_access;
         SymbolTable *parent_scope = current_scope;
         current_scope = al.make_new<SymbolTable>(parent_scope);
+        for (size_t i=0; i<x.n_args; i++) {
+            char *arg=x.m_args[i].m_arg;
+            std::string arg_s = arg;
+            current_procedure_args.push_back(arg);
+        }
         for (size_t i=0; i<x.n_decl; i++) {
             visit_unit_decl2(*x.m_decl[i]);
         }
@@ -622,6 +628,7 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
         }
         parent_scope->scope[sym_name] = ASR::down_cast<ASR::symbol_t>(asr);
         current_scope = parent_scope;
+        current_procedure_args.clear();
     }
 
     AST::AttrType_t* find_return_type(AST::decl_attribute_t** attributes,
@@ -646,6 +653,11 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
         ASR::accessType s_access = dflt_access;
         SymbolTable *parent_scope = current_scope;
         current_scope = al.make_new<SymbolTable>(parent_scope);
+        for (size_t i=0; i<x.n_args; i++) {
+            char *arg=x.m_args[i].m_arg;
+            std::string arg_s = arg;
+            current_procedure_args.push_back(arg);
+        }
         for (size_t i=0; i<x.n_decl; i++) {
             visit_unit_decl2(*x.m_decl[i]);
         }
@@ -763,6 +775,7 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
         }
         parent_scope->scope[sym_name] = ASR::down_cast<ASR::symbol_t>(asr);
         current_scope = parent_scope;
+        current_procedure_args.clear();
     }
 
     void visit_StrOp(const AST::StrOp_t &x) { 
@@ -948,7 +961,14 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
                                 x.base.base.loc);
                     }
                 }
-                ASR::intentType s_intent=intent_local;
+                ASR::intentType s_intent;
+                if (std::find(current_procedure_args.begin(), 
+                        current_procedure_args.end(), s.m_name) != 
+                        current_procedure_args.end()) {
+                    s_intent = intent_unspecified;
+                } else {
+                    s_intent = intent_local;
+                }
                 Vec<ASR::dimension_t> dims;
                 dims.reserve(al, 0);
                 if (x.n_attributes > 0) {
@@ -992,6 +1012,10 @@ class SymbolTableVisitor : public AST::BaseVisitor<SymbolTableVisitor>
                                     s_intent = intent_inout;
                                     break;
                                 }
+                                default : {
+                                    s_intent = intent_unspecified;
+                                    break;
+                                }
                             }
                         } else if (AST::is_a<AST::AttrDimension_t>(*a)) {
                             AST::AttrDimension_t *ad =

tests/reference/asr-intent_01-c1f267a.json

@@ -0,0 +1,13 @@
+{
+    "basename": "asr-intent_01-c1f267a",
+    "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}",
+    "infile": "tests/../integration_tests/intent_01.f90",
+    "infile_hash": "ecbce2d4b01a09bee24ec92ce8be335f75903e746d23a667806bf264",
+    "outfile": null,
+    "outfile_hash": null,
+    "stdout": "asr-intent_01-c1f267a.stdout",
+    "stdout_hash": "a71cab6258ca514b936199ee16fbcc315fa16596fc049a24f304b94a",
+    "stderr": null,
+    "stderr_hash": null,
+    "returncode": 0
+}

tests/reference/asr-intent_01-c1f267a.stdout

@@ -0,0 +1 @@
+(TranslationUnit (SymbolTable 1 {dflt_intent: (Module (SymbolTable 2 {foo: (Subroutine (SymbolTable 3 {c: (Variable 3 c Unspecified () Default (Real 4 []) Source Public), d: (Variable 3 d Unspecified () Default (Real 4 []) Source Public), e: (Variable 3 e Local () Default (Real 4 []) Source Public), f: (Function (SymbolTable 4 {f: (Variable 4 f ReturnVar () Default (Real 4 []) Source Public), x: (Variable 4 x In () Default (Real 4 []) Source Public)}) f [(Var 4 x)] [(= (Var 4 f) (BinOp (ImplicitCast (ConstantInteger 2 (Integer 4 [])) IntegerToReal (Real 4 [])) Mul (Var 4 x) (Real 4 []))) (Print () [(Var 4 f)])] (Var 4 f) Source Public), g: (Variable 3 g Local () Default (Real 4 []) Source Public)}) foo [(Var 3 c) (Var 3 d)] [(= (Var 3 e) (FunctionCall 3 f () [(Var 3 c)] [] (Real 4 []))) (= (Var 3 g) (FunctionCall 3 f () [(Var 3 d)] [] (Real 4 [])))] Source Public)}) dflt_intent [] .false.), main: (Program (SymbolTable 5 {foo: (ExternalSymbol 5 foo 2 foo dflt_intent foo Public)}) main [dflt_intent] [(SubroutineCall 5 foo () [(ConstantReal "0.0" (Real 4 [])) (ConstantReal "2.0" (Real 4 []))])])}) [])

tests/reference/ast-intent_01-fd00f62.json

@@ -0,0 +1,13 @@
+{
+    "basename": "ast-intent_01-fd00f62",
+    "cmd": "lfortran --show-ast --no-color {infile} -o {outfile}",
+    "infile": "tests/../integration_tests/intent_01.f90",
+    "infile_hash": "ecbce2d4b01a09bee24ec92ce8be335f75903e746d23a667806bf264",
+    "outfile": null,
+    "outfile_hash": null,
+    "stdout": "ast-intent_01-fd00f62.stdout",
+    "stdout_hash": "9f8946cb1206dc4416f691c19a4fb8173e9f0cc2d34111f902de28af",
+    "stderr": null,
+    "stderr_hash": null,
+    "returncode": 0
+}

tests/reference/ast-intent_01-fd00f62.stdout

@@ -0,0 +1 @@
+(TranslationUnit [(Module dflt_intent [] [] [] [(Subroutine foo [(c) (d)] () [] [] [] [(Declaration (AttrType TypeReal [] ()) [] [(c [] ()) (d [] ()) (e [] ()) (g [] ())])] [(= 0 e (FuncCallOrArray f [] [(() c ())] [])) (= 0 g (FuncCallOrArray f [] [(() d ())] []))] [(Function f [(x)] [(AttrType TypeReal [] ())] () () [] [] [] [(Declaration (AttrType TypeReal [] ()) [(AttrIntent In)] [(x [] ())])] [(= 0 f (* 2 x)) (Print 0 () [f])] [])])]) (Program main [(Use dflt_intent [])] [] [] [(SubroutineCall 0 foo [(() (Real "0.0") ()) (() (Real "2.0") ())] [])] [])])

tests/reference/llvm-intent_01-9769e74.json

@@ -0,0 +1,13 @@
+{
+    "basename": "llvm-intent_01-9769e74",
+    "cmd": "lfortran --show-llvm {infile} -o {outfile}",
+    "infile": "tests/../integration_tests/intent_01.f90",
+    "infile_hash": "ecbce2d4b01a09bee24ec92ce8be335f75903e746d23a667806bf264",
+    "outfile": null,
+    "outfile_hash": null,
+    "stdout": "llvm-intent_01-9769e74.stdout",
+    "stdout_hash": "444fb1b18cfae0d36e53959dc16508c87d0dbc57333b263de3bdb719",
+    "stderr": null,
+    "stderr_hash": null,
+    "returncode": 0
+}

tests/reference/llvm-intent_01-9769e74.stdout

@@ -0,0 +1,41 @@
+; ModuleID = 'LFortran'
+source_filename = "LFortran"
+
+@0 = private unnamed_addr constant [4 x i8] c"%f\0A\00", align 1
+
+define float @__module_dflt_intent_f(float* %x) {
+.entry:
+  %f = alloca float, align 4
+  %0 = load float, float* %x, align 4
+  %1 = fmul float 2.000000e+00, %0
+  store float %1, float* %f, align 4
+  %2 = load float, float* %f, align 4
+  %3 = fpext float %2 to double
+  call void (i8*, ...) @_lfortran_printf(i8* getelementptr inbounds ([4 x i8], [4 x i8]* @0, i32 0, i32 0), double %3)
+  %4 = load float, float* %f, align 4
+  ret float %4
+}
+
+declare void @_lfortran_printf(i8*, ...)
+
+define void @__module_dflt_intent_foo(float* %c, float* %d) {
+.entry:
+  %e = alloca float, align 4
+  %g = alloca float, align 4
+  %0 = call float @__module_dflt_intent_f(float* %c)
+  store float %0, float* %e, align 4
+  %1 = call float @__module_dflt_intent_f(float* %d)
+  store float %1, float* %g, align 4
+  ret void
+}
+
+define i32 @main() {
+.entry:
+  %0 = alloca float, align 4
+  store float 0.000000e+00, float* %0, align 4
+  %1 = alloca float, align 4
+  store float 2.000000e+00, float* %1, align 4
+  call void @__module_dflt_intent_foo(float* %0, float* %1)
+  ret i32 0
+}
+

tests/tests.toml

@@ -949,3 +949,9 @@ ast_f90 = true
 filename = "implicit1.f90"
 ast = true
 ast_f90 = true
+
+[[test]]
+filename = "../integration_tests/intent_01.f90"
+ast = true
+asr = true
+llvm = true