fortran-src 0.16.1 → 0.16.2

raw patch · 15 files changed

+143/−91 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−1
• app/Main.hs +1/−1
• fortran-src.cabal +1/−1
• src/Language/Fortran/AST.hs +42/−39
• src/Language/Fortran/AST/AList.hs +2/−2
• src/Language/Fortran/AST/Literal.hs +1/−1
• src/Language/Fortran/AST/Literal/Boz.hs +1/−1
• src/Language/Fortran/AST/Literal/Complex.hs +2/−2
• src/Language/Fortran/AST/Literal/Real.hs +6/−3
• src/Language/Fortran/Analysis.hs +1/−1
• src/Language/Fortran/Analysis/DataFlow.hs +45/−14
• src/Language/Fortran/Repr/Eval/Value.hs +12/−10
• src/Language/Fortran/Util/ModFile.hs +9/−7
• test/Language/Fortran/Analysis/ModFileSpec.hs +3/−2
• test/Language/Fortran/Repr/EvalSpec.hs +8/−6

@@ -1,4 +1,12 @@-### 0.16.0 (Sept 4, 2024)+### 0.16.2 (Sep 13, 2024)+  * Small change to allow a path to be added when building mod-file naming map+  * Improvements to the power of constant propagation and constant expression evaluation.++### 0.16.1 (Sep 04, 2024)+  * Minor fix to `fromConstReal` which was partial.+  * Added `Ord` instance for `AST` and all its sub data types, allowing, for example, ASTs to be in containers like Data.Set++### 0.16.0 (Sep 04, 2024)   * Added `--show-make-list` option to give a topological sort on the dependency graph for a source tree   * Added `--version` option   * Some robustness improvements around mod files [#286](https://github.com/camfort/fortran-src/pull/286)

@@ -51,7 +51,7 @@ programName = "fortran-src"  showVersion :: String-showVersion = "0.16.1"+showVersion = "0.16.2"  main :: IO () main = do

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           fortran-src-version:        0.16.1+version:        0.16.2 synopsis:       Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial). description:    Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, Fortran 95, Fortran 2003 (partial) and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the @<https://hackage.haskell.org/package/camfort CamFort>@ project, which uses fortran-src as its front end. category:       Language

@@ -14,6 +14,9 @@   * Fortran 90 standard: ANSI X3.198-1992 (also ISO/IEC 1539:1991)   * Fortran 90 Handbook (J. Adams)   * Fortran 77 standard: ANSI X3.9-1978++Note that the 'Ord' instances provided here do not guarantee any specific+behaviour, other than being valid instances (they are largely for convenience). -}  module Language.Fortran.AST@@ -172,7 +175,7 @@   , typeSpecSpan :: SrcSpan   , typeSpecBaseType :: BaseType   , typeSpecSelector :: Maybe (Selector a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | The "kind selector" of a declaration statement. Tightly bound to --   'TypeSpec'.@@ -195,16 +198,16 @@   , selectorSpan :: SrcSpan   , selectorLength :: Maybe (Expression a)   , selectorKind   :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data MetaInfo = MetaInfo { miVersion :: FortranVersion, miFilename :: String }-  deriving stock (Eq, Show, Data, Generic)+  deriving stock (Eq, Ord, Show, Data, Generic)  -- Program structure definition data ProgramFile a = ProgramFile   { programFileMeta :: MetaInfo   , programFileProgramUnits :: [ ProgramUnit a ]-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  pfSetFilename :: String -> ProgramFile a -> ProgramFile a pfSetFilename fn (ProgramFile mi pus) = ProgramFile (mi { miFilename = fn }) pus@@ -259,7 +262,7 @@   | PUComment                       -- ^ Program unit-level comment       a SrcSpan       (Comment a)-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  type Prefixes a = Maybe (AList Prefix a) type Suffixes a = Maybe (AList Suffix a)@@ -277,7 +280,7 @@ data Prefix a = PfxRecursive a SrcSpan               | PfxElemental a SrcSpan               | PfxPure a SrcSpan-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- see C1241 & C1242 (Fortran2003) validPrefixSuffix :: PrefixSuffix a -> Bool@@ -291,7 +294,7 @@     sfxs = aStrip' msfxs  data Suffix a = SfxBind a SrcSpan (Maybe (Expression a))-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  programUnitBody :: ProgramUnit a -> [Block a] programUnitBody (PUMain _ _ _ bs _)              = bs@@ -323,7 +326,7 @@ programUnitSubprograms PUComment{}                 = Nothing  newtype Comment a = Comment String-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Block a =     BlStatement                              -- ^ Statement@@ -391,7 +394,7 @@   | BlComment                                -- ^ Block-level comment                 a SrcSpan                 (Comment a)-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Statement a  =     StDeclaration@@ -615,7 +618,7 @@   -- Following is a temporary solution to a complicated FORMAT statement   -- parsing problem.   | StFormatBogus         a SrcSpan String-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- R1214 proc-decl is procedure-entity-name [=> null-init] data ProcDecl a = ProcDecl@@ -623,12 +626,12 @@   , procDeclSpan       :: SrcSpan   , procDeclEntityName :: Expression a   , procDeclInitName   :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- R1212 proc-interface is interface-name or declaration-type-spec data ProcInterface a = ProcInterfaceName a SrcSpan (Expression a)                      | ProcInterfaceType a SrcSpan (TypeSpec a)-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Part of a FORALL statement. Introduced in Fortran 95. data ForallHeader a = ForallHeader@@ -636,7 +639,7 @@   , forallHeaderSpan    :: SrcSpan   , forallHeaderHeaders :: [ForallHeaderPart a]   , forallHeaderScaling :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data ForallHeaderPart a = ForallHeaderPart   { forallHeaderPartAnno   :: a@@ -645,13 +648,13 @@   , forallHeaderPartStart  :: Expression a   , forallHeaderPartEnd    :: Expression a   , forallHeaderPartStride :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Only = Exclusive | Permissive-  deriving stock (Eq, Show, Data, Generic)+  deriving stock (Eq, Ord, Show, Data, Generic)  data ModuleNature = ModIntrinsic | ModNonIntrinsic-  deriving stock (Eq, Show, Data, Generic)+  deriving stock (Eq, Ord, Show, Data, Generic)  -- | Part of USE statement. /(F2018 14.2.2)/ --@@ -664,7 +667,7 @@   | UseID         a SrcSpan         (Expression a) -- ^ name-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- TODO potentially should throw Maybe String into ArgumentExpression too? data Argument a = Argument@@ -672,7 +675,7 @@   , argumentSpan :: SrcSpan   , argumentName :: Maybe String   , argumentExpr :: ArgumentExpression a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Extra data type to disambiguate between plain variable arguments and --   expression arguments (due to apparent behaviour of some Fortran compilers@@ -683,7 +686,7 @@ data ArgumentExpression a   = ArgExpr              (Expression a)   | ArgExprVar a SrcSpan Name-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  instance Annotated ArgumentExpression where     getAnnotation = \case@@ -729,17 +732,17 @@   | AttrTarget a SrcSpan   | AttrValue a SrcSpan   | AttrVolatile a SrcSpan-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Intent = In | Out | InOut-  deriving stock (Eq, Show, Data, Generic)+  deriving stock (Eq, Ord, Show, Data, Generic)  data ControlPair a = ControlPair   { controlPairAnno :: a   , controlPairSpan :: SrcSpan   , controlPairName :: Maybe String   , controlPairExpr :: Expression a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Part of ALLOCATE statement. --@@ -754,7 +757,7 @@         a SrcSpan         (Expression a) -- ^ scalar character variable   | AOSource a SrcSpan (Expression a)-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | List of names for an IMPLICIT statement. data ImpList a = ImpList@@ -762,14 +765,14 @@   , impListSpan :: SrcSpan   , impListType :: TypeSpec a   , impListElements :: AList ImpElement a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data ImpElement a = ImpElement   { impElementAnno :: a   , impElementSpan :: SrcSpan   , impElementFrom :: Char   , impElementTo   :: Maybe Char-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | A single COMMON block definition. --@@ -779,14 +782,14 @@   , commonGroupSpan :: SrcSpan   , commonGroupName :: Maybe (Expression a)   , commonGroupVars :: AList Declarator a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Namelist a = Namelist   { namelistAnno :: a   , namelistSpan :: SrcSpan   , namelistName :: Expression a   , namelistVars :: AList Expression a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | The part of a DATA statement describing a single set of initializations. --@@ -799,7 +802,7 @@   , dataGroupSpan         :: SrcSpan   , dataGroupNames        :: AList Expression a   , dataGroupInitializers :: AList Expression a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Field types in pre-Fortran 90 non-standard structure/record/union --   extension.@@ -821,13 +824,13 @@         (Maybe String)          -- ^ Substructure name         String                  -- ^ Field name         (AList StructureItem a) -- ^ Substructure fields-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data UnionMap a = UnionMap   { unionMapAnno   :: a   , unionMapSpan   :: SrcSpan   , unionMapFields :: AList StructureItem a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data FormatItem a =     FIFormatList            a             SrcSpan   (Maybe String) (AList FormatItem a)@@ -838,7 +841,7 @@   | FIFieldDescriptorAIL    a             SrcSpan   (Maybe Integer)   Char          Integer   | FIBlankDescriptor       a             SrcSpan   Integer   | FIScaleFactor           a             SrcSpan   Integer-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Part of the newer (Fortran 2003?) FLUSH statement. --@@ -856,7 +859,7 @@   | FSErr         a SrcSpan         (Expression a) -- ^ statement label-    deriving stock (Eq, Show, Data, Generic, Functor)+    deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data DoSpecification a = DoSpecification   { doSpecAnno      :: a@@ -864,7 +867,7 @@   , doSpecInitial   :: Statement a -- ^ Guaranteed to be 'StExpressionAssign'   , doSpecLimit     :: Expression a   , doSpecIncrement :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Expression a =     ExpValue         a SrcSpan (Value a)@@ -885,7 +888,7 @@   -- ^ Array initialisation   | ExpReturnSpec    a SrcSpan (Expression a)   -- ^ Function return value specification-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data Index a =     IxSingle a SrcSpan (Maybe String) (Expression a)@@ -893,7 +896,7 @@             (Maybe (Expression a)) -- ^ Lower index             (Maybe (Expression a)) -- ^ Upper index             (Maybe (Expression a)) -- ^ Stride-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Values and literals. --@@ -925,7 +928,7 @@   | ValType         String   | ValStar   | ValColon                   -- see R402 / C403 in Fortran2003 spec.-    deriving stock    (Eq, Show, Data, Generic, Functor)+    deriving stock    (Eq, Ord, Show, Data, Generic, Functor)     deriving anyclass (NFData, Out)  -- | Declarators. R505 entity-decl from F90 ISO spec.@@ -949,12 +952,12 @@   , declaratorType     :: DeclaratorType a   , declaratorLength   :: Maybe (Expression a)   , declaratorInitial  :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data DeclaratorType a   = ScalarDecl   | ArrayDecl (AList DimensionDeclarator a)-  deriving stock (Eq, Show, Data, Generic, Functor)+  deriving stock (Eq, Ord, Show, Data, Generic, Functor)  -- | Set a 'Declarator''s initializing expression only if it has none already. setInitialisation :: Declarator a -> Expression a -> Declarator a@@ -968,7 +971,7 @@   , dimDeclSpan :: SrcSpan   , dimDeclLower :: Maybe (Expression a)   , dimDeclUpper :: Maybe (Expression a)-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  data UnaryOp =     Plus

@@ -21,7 +21,7 @@   { alistAnno :: a   , alistSpan :: SrcSpan   , alistList :: [t a]-  } deriving stock (Eq, Show, Data, Generic)+  } deriving stock (Eq, Ord, Show, Data, Generic)  instance Functor t => Functor (AList t) where   fmap f (AList a s xs) = AList (f a) s (map (fmap f) xs)@@ -76,7 +76,7 @@   , atupleSpan :: SrcSpan   , atupleFst  :: t1 a   , atupleSnd  :: t2 a-  } deriving stock (Eq, Show, Data, Generic, Functor)+  } deriving stock (Eq, Ord, Show, Data, Generic, Functor)  instance FirstParameter (ATuple t1 t2 a) a instance SecondParameter (ATuple t1 t2 a) SrcSpan

@@ -14,7 +14,7 @@ data KindParam a   = KindParamInt a SrcSpan String -- ^ @[0-9]+@   | KindParamVar a SrcSpan Name   -- ^ @[a-z][a-z0-9]+@ (case insensitive)-    deriving stock    (Eq, Show, Data, Typeable, Generic, Functor)+    deriving stock    (Eq, Ord, Show, Data, Typeable, Generic, Functor)     deriving anyclass (NFData, Out)  instance FirstParameter  (KindParam a) a

@@ -71,7 +71,7 @@                                 _                            -> False  data Conforming = Conforming | Nonconforming-    deriving stock    (Eq, Show, Generic, Data, Typeable, Ord)+    deriving stock    (Eq, Ord, Show, Generic, Data, Typeable)     deriving anyclass (NFData, Out)  -- | UNSAFE. Parses a BOZ literal constant string.

@@ -27,7 +27,7 @@   , complexLitPos      :: SrcSpan   , complexLitRealPart :: ComplexPart a   , complexLitImagPart :: ComplexPart a-  } deriving stock    (Eq, Show, Data, Typeable, Generic, Functor)+  } deriving stock    (Eq, Ord, Show, Data, Typeable, Generic, Functor)     deriving anyclass (NFData, Out)  instance FirstParameter  (ComplexLit a) a@@ -51,7 +51,7 @@   = ComplexPartReal   a SrcSpan RealLit (Maybe (KindParam a)) -- ^ signed real lit   | ComplexPartInt    a SrcSpan String  (Maybe (KindParam a)) -- ^ signed int  lit   | ComplexPartNamed  a SrcSpan Name                          -- ^ named constant-    deriving stock    (Eq, Show, Data, Typeable, Generic, Functor)+    deriving stock    (Eq, Ord, Show, Data, Typeable, Generic, Functor)     deriving anyclass (NFData, Out)  instance FirstParameter  (ComplexPart a) a

@@ -40,13 +40,15 @@   -- ^ A string representing a signed decimal.   -- ^ Approximate regex: @-? ( [0-9]+ \. [0-9]* | \. [0-9]+ )@   , realLitExponent    :: Exponent-  } deriving (Eq, Show, Data, Typeable, Generic, NFData, Out, Ord)+  } deriving stock (Eq, Ord, Show, Data, Typeable, Generic)+    deriving anyclass (NFData, Out)  -- | An exponent is an exponent letter (E, D) and a signed integer. data Exponent = Exponent   { exponentLetter :: ExponentLetter   , exponentNum    :: String-  } deriving (Eq, Show, Data, Typeable, Generic, NFData, Out, Ord)+  } deriving stock (Eq, Ord, Show, Data, Typeable, Generic)+    deriving anyclass (NFData, Out)  -- Note: Some Fortran language references include extensions here. HP's F90 -- reference provides a Q exponent letter which sets kind to 16.@@ -54,7 +56,8 @@   = ExpLetterE -- ^ KIND=4 (float)   | ExpLetterD -- ^ KIND=8 (double)   | ExpLetterQ -- ^ KIND=16 ("quad", rare? extension)-    deriving (Eq, Show, Data, Typeable, Generic, NFData, Out, Ord)+    deriving stock (Eq, Ord, Show, Data, Typeable, Generic)+    deriving anyclass (NFData, Out)  -- | Prettify a 'RealLit' in a Haskell-compatible way. prettyHsRealLit :: RealLit -> String

@@ -3,7 +3,7 @@ -- | -- Common data structures and functions supporting analysis of the AST. module Language.Fortran.Analysis-  ( initAnalysis, stripAnalysis, Analysis(..)+  ( initAnalysis, analysis0, stripAnalysis, Analysis(..)   , varName, srcName, lvVarName, lvSrcName, isNamedExpression   , genVar, puName, puSrcName, blockRhsExprs, rhsExprs   , ModEnv, NameType(..), Locality(..), markAsImported, isImported

@@ -368,31 +368,62 @@ -- | Generate a constant-expression map with information about the -- expressions (identified by insLabel numbering) in the ProgramFile -- pf (must have analysis initiated & basic blocks generated) .-genConstExpMap :: forall a. Data a => ProgramFile (Analysis a) -> ConstExpMap+genConstExpMap :: forall a. (Data a) => ProgramFile (Analysis a) -> ConstExpMap genConstExpMap pf = ceMap   where-    -- Generate map of 'parameter' variables, obtaining their value from ceMap below, lazily.-    pvMap = M.fromList $-      [ (varName v, getE e)-      | st@(StDeclaration _ _ (TypeSpec _ _ _ _) _ _) <- universeBi pf :: [Statement (Analysis a)]-      , AttrParameter _ _ <- universeBi st :: [Attribute (Analysis a)]-      , (Declarator _ _ v ScalarDecl _ (Just e)) <- universeBi st ] ++-      [ (varName v, getE e)-      | st@StParameter{} <- universeBi pf :: [Statement (Analysis a)]-      , (Declarator _ _ v ScalarDecl _ (Just e)) <- universeBi st ]-    getV :: Expression (Analysis a) -> Maybe Repr.FValue-    getV e = constExp (getAnnotation e) `mplus` (join . flip M.lookup pvMap . varName $ e)-     -- Generate map of information about 'constant expressions'.     ceMap = IM.fromList [ (label, doExpr e) | e <- universeBi pf, Just label <- [labelOf e] ]++    -- Initial map of parameter declarations+    pvMap :: M.Map Name Repr.FValue+    pvMap = execState (recursivelyProcessDecls declarations) M.empty++    -- Gather all the declarations in order+    declarations :: [Statement (Analysis a)]+    declarations =+      flip filter (universeBi pf :: [Statement (Analysis a)]) $+          \case+              StDeclaration{} -> True+              StParameter{}   -> True+              _               -> False++    recursivelyProcessDecls :: [Statement (Analysis a)] -> State (M.Map Name Repr.FValue) ()+    recursivelyProcessDecls [] = return ()+    recursivelyProcessDecls (stmt:stmts) = do+      let internalDecls =+            case stmt of+              (StDeclaration _ _ (TypeSpec _ _ _ _) _ _) ->+                -- Gather up all the declarations that are contain in this StDeclaration+                -- (there could be many)+                [ (varName v, e)+                   | (Declarator _ _ v _ _ (Just e)) <- universeBi stmt :: [Declarator (Analysis a)]+                    , AttrParameter _ _ <- universeBi stmt :: [Attribute (Analysis a)] ]++              StParameter{} ->+                [(varName v, e) | (Declarator _ _ v ScalarDecl _ (Just e)) <- universeBi stmt ]+              _ -> []+      -- Now process these decls+      forM_ internalDecls (\(v, e) -> modify (\map ->+        case getE0 map e of+          Just evalExpr -> M.insert v evalExpr map+          Nothing       -> map))+      recursivelyProcessDecls stmts++    -- Evaluate an expression down to a value+    getE0 :: M.Map Name Repr.FValue -> Expression (Analysis a) -> Maybe (Repr.FValue)+    getE0 pvMap e = either (const Nothing) (Just . fst) (Repr.runEvalFValuePure pvMap (Repr.evalExpr e))++    -- Lookup an expression in the constants maps     getE :: Expression (Analysis a) -> Maybe Repr.FValue     getE = join . (flip IM.lookup ceMap <=< labelOf)+     labelOf = insLabel . getAnnotation+     doExpr :: Expression (Analysis a) -> Maybe Repr.FValue     doExpr e =         -- TODO constants may use other constants! but genConstExpMap needs more         -- changes to support that-        case Repr.runEvalFValuePure mempty (Repr.evalExpr e) of+        case Repr.runEvalFValuePure pvMap (Repr.evalExpr e) of           Left _err -> Nothing           Right (a, _msgs) -> Just a 

@@ -25,6 +25,8 @@ import Language.Fortran.Repr.Eval.Common import qualified Language.Fortran.Repr.Eval.Value.Op as Op +import qualified Language.Fortran.Analysis as FA+ import GHC.Generics ( Generic ) import qualified Data.Text as Text import qualified Data.Char@@ -102,11 +104,11 @@       Nothing  -> err $ ENoSuchVar name       Just val -> pure val -evalExpr :: MonadFEvalValue m => F.Expression a -> m FValue+evalExpr :: MonadFEvalValue m => F.Expression (FA.Analysis a) -> m FValue evalExpr = \case-  F.ExpValue _ _ astVal ->+  e@(F.ExpValue _ _ astVal) ->     case astVal of-      F.ValVariable name -> evalVar name+      F.ValVariable name -> evalVar (FA.varName e)       -- TODO: Do same with ValIntrinsic??? idk...       _ -> MkFScalarValue <$> evalLit astVal   F.ExpUnary  _ _ uop e   -> do@@ -125,13 +127,13 @@     evalFunctionCall (forceVarExpr ve) evaledArgs   _ -> err $ EUnsupported "Expression constructor" -forceVarExpr :: F.Expression a -> F.Name+forceVarExpr :: F.Expression (FA.Analysis a) -> F.Name forceVarExpr = \case   F.ExpValue _ _ (F.ValVariable v) -> v   F.ExpValue _ _ (F.ValIntrinsic v) -> v   _ -> error "program error, sent me an expr that wasn't a name" -evalLit :: MonadFEvalValue m => F.Value a -> m FScalarValue+evalLit :: MonadFEvalValue m => F.Value (FA.Analysis a) -> m FScalarValue evalLit = \case   F.ValInteger i mkp -> do     evalMKp 4 mkp >>= \case@@ -176,7 +178,7 @@ err :: MonadError Error m => Error -> m a err = throwError -evalKp :: MonadFEvalValue m => F.KindParam a -> m FKindLit+evalKp :: MonadFEvalValue m => F.KindParam (FA.Analysis a) -> m FKindLit evalKp = \case   F.KindParamInt _ _ k ->     -- TODO we may wish to check kind param sensibility here@@ -192,14 +194,14 @@         _ -> err $ EKindLitBadType var (fValueType val)       Nothing  -> err $ ENoSuchVar var -evalMKp :: MonadFEvalValue m => FKindLit -> Maybe (F.KindParam a) -> m FKindLit+evalMKp :: MonadFEvalValue m => FKindLit -> Maybe (F.KindParam (FA.Analysis a)) -> m FKindLit evalMKp kDef = \case   Nothing -> pure kDef   Just kp -> evalKp kp  -- TODO needs cleanup: internal repetition, common parts with evalKp. also needs -- a docstring-evalRealKp :: MonadFEvalValue m => F.ExponentLetter -> Maybe (F.KindParam a) -> m FKindLit+evalRealKp :: MonadFEvalValue m => F.ExponentLetter -> Maybe (F.KindParam (FA.Analysis a)) -> m FKindLit evalRealKp l = \case   Nothing ->     case l of@@ -425,7 +427,7 @@         err $ EOpTypeError $             "int: unsupported or unimplemented type: "<>show (fScalarValueType v') -evalArg :: MonadFEvalValue m => F.Argument a -> m FValue+evalArg :: MonadFEvalValue m => F.Argument (FA.Analysis a) -> m FValue evalArg (F.Argument _ _ _ ae) =     case ae of       F.ArgExpr        e -> evalExpr e@@ -493,5 +495,5 @@                 "max: unsupported type: "<> show (fScalarValueType vCurMax)  -- | Evaluate a constant expression (F2018 10.1.12).-evalConstExpr :: MonadFEvalValue m => F.Expression a -> m FValue+evalConstExpr :: MonadFEvalValue m => F.Expression (FA.Analysis a) -> m FValue evalConstExpr = evalExpr

@@ -80,7 +80,7 @@ import GHC.Generics (Generic) import System.Directory ( doesFileExist, getModificationTime ) import qualified System.FilePath-import System.FilePath ( (-<.>), (</>) )+import System.FilePath ( (-<.>), (</>), normalise ) import System.IO ( hPutStrLn, stderr )  --------------------------------------------------@@ -139,7 +139,7 @@ -- | Extracts the module map, declaration map and type analysis from -- an analysed and renamed ProgramFile, then inserts it into the -- ModFile.-regenModFile :: forall a. Data a => F.ProgramFile (FA.Analysis a) -> ModFile -> ModFile+regenModFile :: forall a. (Data a) => F.ProgramFile (FA.Analysis a) -> ModFile -> ModFile regenModFile pf mf = mf { mfModuleMap   = extractModuleMap pf                         , mfDeclMap     = extractDeclMap pf                         , mfTypeEnv     = FAT.extractTypeEnv pf@@ -148,7 +148,7 @@  -- | Generate a fresh ModFile from the module map, declaration map and -- type analysis of a given analysed and renamed ProgramFile.-genModFile :: forall a. Data a => F.ProgramFile (FA.Analysis a) -> ModFile+genModFile :: forall a. (Data a) => F.ProgramFile (FA.Analysis a) -> ModFile genModFile = flip regenModFile emptyModFile  -- | Looks up the raw "other data" that may be stored in a ModFile by@@ -250,11 +250,13 @@  -- | Create a map that links all unique variable/function names in the -- ModFiles to their corresponding *originating* filename (i.e., where they are declared)-genUniqNameToFilenameMap :: ModFiles -> M.Map F.Name String-genUniqNameToFilenameMap = M.unions . map perMF+genUniqNameToFilenameMap :: FilePath -> ModFiles -> M.Map F.Name String+genUniqNameToFilenameMap localPath = M.unions . map perMF   where-    perMF mf = M.fromList [ (n, fname) | modEnv <- M.elems localModuleMap-                                       , (n, _) <- M.elems modEnv ]+    perMF mf = M.fromList+                [ (n, normalise $ localPath </> fname)+                   | modEnv <- M.elems localModuleMap+                   , (n, _) <- M.elems modEnv ]       where         -- Make sure that we remove imported declarations so we can         -- properly localise declarations to the originator file.

@@ -34,12 +34,13 @@ -- of the variable `constant` to the leaf module, whilst understanding -- in the `mid1` and `mid2` modules that it is an imported declaration. testModuleMaps = do-    paths <- expandDirs ["test-data" </> "module"]+    let fixturePath = "test-data" </> "module"+    paths <- expandDirs [fixturePath]     -- parse all files into mod files     pfs <- mapM (\p -> pParser p) paths     let modFiles = map genModFile pfs     -- get unique name to filemap-    let mmap = genUniqNameToFilenameMap modFiles+    let mmap = genUniqNameToFilenameMap "" modFiles     -- check that `constant` is declared in leaf.f90     let Just leaf = M.lookup "leaf_constant_1" mmap     leaf `shouldBe` ("test-data" </> "module" </> "leaf.f90")

@@ -10,6 +10,8 @@ import Language.Fortran.Repr import Language.Fortran.Repr.Eval.Value +import Language.Fortran.Analysis+ import Data.Int  spec :: Spec@@ -29,15 +31,15 @@           -- _ -> expectationFailure "not a scalar"       Left e -> expectationFailure (show e) -expBinary :: BinaryOp -> Expression () -> Expression () -> Expression ()-expBinary = ExpBinary () u+expBinary :: BinaryOp -> Expression (Analysis ()) -> Expression (Analysis ()) -> Expression (Analysis ())+expBinary = ExpBinary (analysis0 ()) u -expValue :: Value () -> Expression ()-expValue = ExpValue () u+expValue :: Value (Analysis ()) -> Expression (Analysis ())+expValue = ExpValue (analysis0 ()) u  -- | default kind. take integral-like over String because nicer to write :)-valInteger :: (Integral a, Show a) => a -> Value ()+valInteger :: (Integral a, Show a) => a -> Value (Analysis ()) valInteger i = ValInteger (show i) Nothing -expValInt :: (Integral a, Show a) => a -> Expression ()+expValInt :: (Integral a, Show a) => a -> Expression (Analysis ()) expValInt = expValue . valInteger