From d6d4d3336ca7b9a0799aabd02d1dd00ac3207f9f Mon Sep 17 00:00:00 2001 From: Ben Orchard Date: Tue, 1 Feb 2022 14:27:41 +0000 Subject: [PATCH 1/4] BBlocks: remove an superfluous filter --- src/Language/Fortran/Analysis/BBlocks.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Fortran/Analysis/BBlocks.hs b/src/Language/Fortran/Analysis/BBlocks.hs index c9ad0c46..3960036d 100644 --- a/src/Language/Fortran/Analysis/BBlocks.hs +++ 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 From 61796b9957a86b40dbc60d146471363bc4f8d0ea Mon Sep 17 00:00:00 2001 From: Ben Orchard Date: Wed, 2 Feb 2022 13:50:31 +0000 Subject: [PATCH 2/4] Analysis: attempt to detect call-by-value exprs --- src/Language/Fortran/Analysis.hs | 6 +++++- src/Language/Fortran/Analysis/BBlocks.hs | 12 +++++++++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/Language/Fortran/Analysis.hs b/src/Language/Fortran/Analysis.hs index 3a6c4f08..1425ceaf 100644 --- a/src/Language/Fortran/Analysis.hs +++ b/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 ] diff --git a/src/Language/Fortran/Analysis/BBlocks.hs b/src/Language/Fortran/Analysis/BBlocks.hs index 3960036d..2a6a1037 100644 --- a/src/Language/Fortran/Analysis/BBlocks.hs +++ b/src/Language/Fortran/Analysis/BBlocks.hs @@ -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 From d2bfb1b5e618a9083a345c2c35e1af4a7739bb61 Mon Sep 17 00:00:00 2001 From: Ben Orchard Date: Thu, 3 Feb 2022 15:17:30 +0000 Subject: [PATCH 3/4] update changelog --- CHANGELOG.md | 7 +++++++ upgrade-guide.md | 13 +++++++++++++ 2 files changed, 20 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 50ec099c..2a2d1cef 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/upgrade-guide.md b/upgrade-guide.md index 8403fd0d..71163ce3 100644 --- a/upgrade-guide.md +++ b/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.*** From 8e1e9844c4e588f88fddbced57431f8591a28345 Mon Sep 17 00:00:00 2001 From: Ben Orchard Date: Thu, 3 Feb 2022 15:17:54 +0000 Subject: [PATCH 4/4] fix parsing optional ID in Argument --- src/Language/Fortran/AST.hs | 13 +++++++++++-- src/Language/Fortran/Parser/Fixed/Fortran66.y | 11 +++++++---- src/Language/Fortran/Parser/Fixed/Fortran77.y | 13 ++++++++----- src/Language/Fortran/Parser/Free/Fortran2003.y | 14 ++++++++------ src/Language/Fortran/Parser/Free/Fortran90.y | 14 ++++++++------ src/Language/Fortran/Parser/Free/Fortran95.y | 14 ++++++++------ 6 files changed, 50 insertions(+), 29 deletions(-) diff --git a/src/Language/Fortran/AST.hs b/src/Language/Fortran/AST.hs index 52ac87a5..11a745d2 100644 --- a/src/Language/Fortran/AST.hs +++ b/src/Language/Fortran/AST.hs @@ -485,8 +485,9 @@ 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 @@ -494,6 +495,14 @@ data ArgumentExpression 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) diff --git a/src/Language/Fortran/Parser/Fixed/Fortran66.y b/src/Language/Fortran/Parser/Fixed/Fortran66.y index 1f0d5c86..50250121 100644 --- a/src/Language/Fortran/Parser/Fixed/Fortran66.y +++ b/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 } diff --git a/src/Language/Fortran/Parser/Fixed/Fortran77.y b/src/Language/Fortran/Parser/Fixed/Fortran77.y index 6c9afde0..c21c43ac 100644 --- a/src/Language/Fortran/Parser/Fixed/Fortran77.y +++ b/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 } diff --git a/src/Language/Fortran/Parser/Free/Fortran2003.y b/src/Language/Fortran/Parser/Free/Fortran2003.y index 301759d0..f718c395 100644 --- a/src/Language/Fortran/Parser/Free/Fortran2003.y +++ b/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 } diff --git a/src/Language/Fortran/Parser/Free/Fortran90.y b/src/Language/Fortran/Parser/Free/Fortran90.y index dc0efa8b..a3fc3db9 100644 --- a/src/Language/Fortran/Parser/Free/Fortran90.y +++ b/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 } diff --git a/src/Language/Fortran/Parser/Free/Fortran95.y b/src/Language/Fortran/Parser/Free/Fortran95.y index d51cf0d1..a229289d 100644 --- a/src/Language/Fortran/Parser/Free/Fortran95.y +++ b/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 }