Handle call-by-value parameters

CHANGELOG.md

@@ -6,6 +6,13 @@
     * The Happy parsers have fewer dependencies, so should no longer require a
       recompile due to apparently unrelated changes.
   * Remove some deprecated shims (from the restructured modules).
+  * `Argument`s now store an `ArgumentExpression` instead of an `Expression`, in
+    order to allow differentiating between regular call-by-reference variables
+    `call func(x)`, and call-by-value ones `call func( (x) )`.
+    * gfortran has this behaviour, and it's (minimally) documented online
+      ([tweet](https://twitter.com/fortrantip/status/1479071485859962880),
+      [StackOverflow](https://stackoverflow.com/q/40700499))
+    * The behaviour is reflected in the basic block/flow graph.
 
 ### 0.8.0 (Jan 04, 2022)
   * Merge declarator constructors. Now you differentiate between array and

src/Language/Fortran/AST.hs

@@ -485,15 +485,24 @@ data Use a =
   | UseID a SrcSpan (Expression a)
   deriving (Eq, Show, Data, Typeable, Generic, Functor)
 
--- TODO potentially should throw Maybe String into ArgumentExpression too?
-data Argument a = Argument a SrcSpan (Maybe String) (ArgumentExpression a)
+data Argument a = Argument a SrcSpan
+                           (Maybe Name)             -- ^ optional @var = ...@
+                           (ArgumentExpression a)   -- ^ expression (wrapped)
   deriving (Eq, Show, Data, Typeable, Generic, Functor)
 
 data ArgumentExpression a
   = ArgExpr              (Expression a)
   | ArgExprVar a SrcSpan Name
   deriving (Eq, Show, Data, Typeable, Generic, Functor)
 
+instance Spanned (ArgumentExpression a) where
+    getSpan = \case
+      ArgExpr            e -> getSpan e
+      ArgExprVar _a  ss _v -> ss
+    setSpan ss = \case
+      ArgExpr            e -> ArgExpr $ setSpan ss e
+      ArgExprVar  a _ss  v -> ArgExprVar a ss v
+
 argExprNormalize :: ArgumentExpression a -> Expression a
 argExprNormalize = \case ArgExpr         e -> e
                          ArgExprVar a ss v -> ExpValue a ss (ValVariable v)

src/Language/Fortran/Analysis.hs

@@ -8,7 +8,7 @@ module Language.Fortran.Analysis
   , varName, srcName, lvVarName, lvSrcName, isNamedExpression
   , genVar, puName, puSrcName, blockRhsExprs, rhsExprs
   , ModEnv, NameType(..), IDType(..), ConstructType(..)
-  , lhsExprs, isLExpr, allVars, analyseAllLhsVars, analyseAllLhsVars1, allLhsVars
+  , lhsExprs, isLExpr, isLExpr', allVars, analyseAllLhsVars, analyseAllLhsVars1, allLhsVars
   , blockVarUses, blockVarDefs
   , BB, BBNode, BBGr(..), bbgrMap, bbgrMapM, bbgrEmpty
   , TransFunc, TransFuncM )
@@ -262,6 +262,10 @@ isLExpr (ExpValue _ _ ValVariable {}) = True
 isLExpr ExpSubscript{}                = True
 isLExpr _                             = False
 
+isLExpr' :: ArgumentExpression a -> Bool
+isLExpr' = \case ArgExprVar{} -> False
+                 ArgExpr e    -> isLExpr e
+
 -- | Set of names found in an AST node.
 allVars :: forall a b. (Data a, Data (b (Analysis a))) => b (Analysis a) -> [Name]
 allVars b = [ varName v | v@(ExpValue _ _ (ValVariable _)) <- uniBi b ]

src/Language/Fortran/Analysis/BBlocks.hs

@@ -349,7 +349,7 @@ perBlock :: Data a => Block (Analysis a) -> BBlocker (Analysis a) ()
 -- invariant: curBB is in reverse order
 perBlock b@(BlIf _ _ _ _ exps bss _) = do
   processLabel b
-  _ <- forM (catMaybes . filter isJust $ exps) processFunctionCalls
+  _ <- forM (catMaybes exps) processFunctionCalls
   addToBBlock $ stripNestedBlocks b
   (ifN, _) <- closeBBlock
 
@@ -428,7 +428,8 @@ perBlock b@(BlStatement _ _ _ (StCall _ _ ExpValue{} Nothing)) = do
   createEdges [ (prevN, callN, ()), (callN, nextN, ()) ]
 perBlock (BlStatement a s l (StCall a' s' cn@ExpValue{} (Just aargs))) = do
   let a0 = head . initAnalysis $ [prevAnnotation a]
-  let exps = map argExtractExpr . aStrip $ aargs
+      exps' = map (\(Argument _ _ _ ae) -> ae) $ aStrip aargs
+      exps  = map argExprNormalize exps'
   (prevN, formalN) <- closeBBlock
 
   -- create bblock that assigns formal parameters (n[1], n[2], ...)
@@ -457,9 +458,14 @@ perBlock (BlStatement a s l (StCall a' s' cn@ExpValue{} (Just aargs))) = do
 
   -- re-assign the variables using the values of the formal parameters, if possible
   -- (because call-by-reference)
-  forM_ (zip exps [(1::Integer)..]) $ \ (e, i) ->
+  -- TODO however, doing @call( (a) )@ essentially turns that parameter into a
+  --      call-by-value. Not fully sure on the semantics here or how formalized
+  --      they are, but checked with gfortran. We handle this by further
+  --      wrapping parameters in the AST, and using another l-expr check.
+  forM_ (zip exps' [(1::Integer)..]) $ \ (arg, i) -> do
     -- this is only possible for l-expressions
-    (when (isLExpr e) $
+    let e = argExprNormalize arg
+    (when (isLExpr' arg) $
       addToBBlock . analyseAllLhsVars1 $
         BlStatement a{ insLabel = Nothing } s l (StExpressionAssign a' s' e (formal e i)))
   (_, nextN) <- closeBBlock

src/Language/Fortran/Parser/Fixed/Fortran66.y

@@ -343,11 +343,14 @@ ARGUMENTS_LEVEL1 :: { AList Argument A0 }
 
 -- Expression all by itself subsumes all other callable expressions.
 CALLABLE_EXPRESSION :: { Argument A0 }
-: HOLLERITH   { Argument () (getSpan $1) Nothing (ArgExpr $1) }
-| '(' VARIABLE ')'
+: HOLLERITH           { Argument () (getSpan $1) Nothing (ArgExpr $1) }
+| ARGUMENT_EXPRESSION { Argument () (getSpan $1) Nothing $1 }
+
+ARGUMENT_EXPRESSION :: { ArgumentExpression A0 }
+: '(' VARIABLE ')'
   { let ExpValue _ _ (ValVariable v) = $2
-     in Argument () (getTransSpan $1 $3) Nothing (ArgExprVar () (getSpan $2) v) }
-| EXPRESSION  { Argument () (getSpan $1) Nothing (ArgExpr $1) }
+     in ArgExprVar () (getTransSpan $1 $3) v }
+| EXPRESSION { ArgExpr $1 }
 
 EXPRESSION :: { Expression A0 }
 : EXPRESSION '+' EXPRESSION { ExpBinary () (getTransSpan $1 $3) Addition $1 $3 }

src/Language/Fortran/Parser/Fixed/Fortran77.y

@@ -740,13 +740,16 @@ CALLABLE_EXPRESSION :: { Argument A0 }
                    (ExpValue () (getTransSpan $1 $2) (ValIntrinsic ('%':name)))
                    (Just args) }
     in Argument () (getTransSpan $1 $5) Nothing (ArgExpr intr) }
-| id '=' EXPRESSION
+| id '=' ARGUMENT_EXPRESSION
   { let TId span keyword = $1
-    in Argument () (getTransSpan span $3) (Just keyword) (ArgExpr $3) }
-| '(' VARIABLE ')'
+     in Argument () (getTransSpan span $3) (Just keyword) $3 }
+| ARGUMENT_EXPRESSION { Argument () (getSpan $1) Nothing $1 }
+
+ARGUMENT_EXPRESSION :: { ArgumentExpression A0 }
+: '(' VARIABLE ')'
   { let ExpValue _ _ (ValVariable v) = $2
-     in Argument () (getTransSpan $1 $3) Nothing (ArgExprVar () (getSpan $2) v) }
-| EXPRESSION  { Argument () (getSpan $1) Nothing (ArgExpr $1) }
+     in ArgExprVar () (getTransSpan $1 $3) v }
+| EXPRESSION { ArgExpr $1 }
 
 EXPRESSION :: { Expression A0 }
 : EXPRESSION '+' EXPRESSION { ExpBinary () (getTransSpan $1 $3) Addition $1 $3 }

src/Language/Fortran/Parser/Free/Fortran2003.y

@@ -780,14 +780,16 @@ ARGUMENTS :: { [ Argument A0 ] }
 | ARGUMENT { [ $1 ] }
 
 ARGUMENT :: { Argument A0 }
-: id '=' EXPRESSION
+: id '=' ARGUMENT_EXPRESSION
   { let TId span keyword = $1
-     in Argument () (getTransSpan span $3) (Just keyword) (ArgExpr $3) }
-| '(' VARIABLE ')'
+     in Argument () (getTransSpan span $3) (Just keyword) $3 }
+| ARGUMENT_EXPRESSION { Argument () (getSpan $1) Nothing $1 }
+
+ARGUMENT_EXPRESSION :: { ArgumentExpression A0 }
+: '(' VARIABLE ')'
   { let ExpValue _ _ (ValVariable v) = $2
-     in Argument () (getTransSpan $1 $3) Nothing (ArgExprVar () (getSpan $2) v) }
-| EXPRESSION
-  { Argument () (getSpan $1) Nothing (ArgExpr $1) }
+     in ArgExprVar () (getTransSpan $1 $3) v }
+| EXPRESSION { ArgExpr $1 }
 
 MAYBE_RENAME_LIST :: { Maybe (AList Use A0) }
 : RENAME_LIST { Just $ fromReverseList $1 }

src/Language/Fortran/Parser/Free/Fortran90.y

@@ -614,14 +614,16 @@ ARGUMENTS :: { [ Argument A0 ] }
 | ARGUMENT { [ $1 ] }
 
 ARGUMENT :: { Argument A0 }
-: id '=' EXPRESSION
+: id '=' ARGUMENT_EXPRESSION
   { let TId span keyword = $1
-     in Argument () (getTransSpan span $3) (Just keyword) (ArgExpr $3) }
-| '(' VARIABLE ')'
+     in Argument () (getTransSpan span $3) (Just keyword) $3 }
+| ARGUMENT_EXPRESSION { Argument () (getSpan $1) Nothing $1 }
+
+ARGUMENT_EXPRESSION :: { ArgumentExpression A0 }
+: '(' VARIABLE ')'
   { let ExpValue _ _ (ValVariable v) = $2
-     in Argument () (getTransSpan $1 $3) Nothing (ArgExprVar () (getSpan $2) v) }
-| EXPRESSION
-  { Argument () (getSpan $1) Nothing (ArgExpr $1) }
+     in ArgExprVar () (getTransSpan $1 $3) v }
+| EXPRESSION { ArgExpr $1 }
 
 MAYBE_RENAME_LIST :: { Maybe (AList Use A0) }
 : RENAME_LIST { Just $ fromReverseList $1 }

src/Language/Fortran/Parser/Free/Fortran95.y

@@ -626,14 +626,16 @@ ARGUMENTS :: { [ Argument A0 ] }
 | ARGUMENT { [ $1 ] }
 
 ARGUMENT :: { Argument A0 }
-: id '=' EXPRESSION
+: id '=' ARGUMENT_EXPRESSION
   { let TId span keyword = $1
-     in Argument () (getTransSpan span $3) (Just keyword) (ArgExpr $3) }
-| '(' VARIABLE ')'
+     in Argument () (getTransSpan span $3) (Just keyword) $3 }
+| ARGUMENT_EXPRESSION { Argument () (getSpan $1) Nothing $1 }
+
+ARGUMENT_EXPRESSION :: { ArgumentExpression A0 }
+: '(' VARIABLE ')'
   { let ExpValue _ _ (ValVariable v) = $2
-     in Argument () (getTransSpan $1 $3) Nothing (ArgExprVar () (getSpan $2) v) }
-| EXPRESSION
-  { Argument () (getSpan $1) Nothing (ArgExpr $1) }
+     in ArgExprVar () (getTransSpan $1 $3) v }
+| EXPRESSION { ArgExpr $1 }
 
 MAYBE_RENAME_LIST :: { Maybe (AList Use A0) }
 : RENAME_LIST { Just $ fromReverseList $1 }

upgrade-guide.md

@@ -13,6 +13,19 @@ modules can be replaced by `Parser.byVer`, `Parser.f77e` etc. The filepath
 argument now comes before the contents bytestring, so you may have to swap
 argument order (done to match other parsing libraries and most common usage).
 
+### `Argument` encodes "call-by-value" variables
+***May necessitate changes.***
+
+`Argument` now stores an `ArgumentExpression` instead of an `Expression`. The
+former is a thin wrapper over the latter to allow tracking when a variable is
+used like "call-by-value" as in `call func( (x) )`.
+
+If you work with `Argument`s instead of the `Expressions`s they used to wrap,
+you'll need to update your code. Use `argExtractExpr :: Argument a -> Expression
+a` to easily recover original behaviour. Or case on the `ArgumentExpression` to
+handle it directly. See the `StCall` match in `Analysis.BBlocks.perBlock`, and
+`Analysis.isLExpr` for related code.
+
 ## Release 0.8.0
 ### Declarator constructor refactor
 ***Necessitates changes.***