Merge pull request #292 from camfort/improveReporting

Improve reporting, mostly around type information but also source spans

Author: dorchard

app/Main.hs

@@ -118,7 +118,7 @@ main = do
                         Right a -> a
           outfmt    = outputFormat opts
           mmap      = combinedModuleMap mods
-          tenv      = combinedTypeEnv mods
+          tenv      = stripExtended $ combinedTypeEnv mods
           pvm       = combinedParamVarMap mods
 
       let runTypes = analyseAndCheckTypesWithEnv tenv . analyseRenamesWithModuleMap mmap . initAnalysis
@@ -143,7 +143,7 @@ main = do
         Lex        -> ioError $ userError $ usageInfo programName options
         Parse      -> pp parsedPF
         Typecheck  -> let (pf, _, errs) = runTypes parsedPF in
-                        printTypeErrors errs >> printTypes (extractTypeEnv pf)
+                        printTypeErrors errs >> printTypes (extractTypeEnvExtended pf)
         Rename     -> pp $ runRenamer parsedPF
         BBlocks    -> putStrLn $ runBBlocks parsedPF
         SuperGraph -> putStrLn $ runSuperGraph parsedPF
@@ -220,7 +220,7 @@ compileFileToMod mvers mods path moutfile = do
   contents <- flexReadFile path
   let version = fromMaybe (deduceFortranVersion path) mvers
       mmap = combinedModuleMap mods
-      tenv = combinedTypeEnv mods
+      tenv = stripExtended $ combinedTypeEnv mods
       runCompile = genModFile . fst . analyseTypesWithEnv tenv . analyseRenamesWithModuleMap mmap . initAnalysis
   parsedPF  <-
     case (Parser.byVerWithMods mods version) path contents of
@@ -295,12 +295,14 @@ showStringMap :: StringMap -> String
 showStringMap = showGenericMap
 showModuleMap :: ModuleMap -> String
 showModuleMap = concatMap (\ (n, m) -> show n ++ ":\n" ++ (unlines . map ("  "++) . lines . showGenericMap $ m)) . M.toList
-showTypes :: TypeEnv -> String
+showTypes :: TypeEnvExtended -> String
 showTypes tenv =
-    flip concatMap (M.toList tenv) $
-      \ (name, IDType { idVType = vt, idCType = ct }) ->
-        printf "%s\t\t%s %s\n" name (drop 1 $ maybe "  -" show vt) (drop 2 $ maybe "   " show ct)
-printTypes :: TypeEnv -> IO ()
+  let sortedInfo = sortBy (\(_, (_, sp1, _)) (_, (_, sp2, _)) -> compare sp1 sp2) $ M.toList tenv
+  in
+    flip concatMap sortedInfo $
+      \ (_, (name, sp, IDType { idVType = vt, idCType = ct })) ->
+        printf "%s\t %s\t\t%s %s\n" (show $ ssFrom sp) name (drop 1 $ maybe "  -" show vt) (drop 2 $ maybe "   " show ct)
+printTypes :: TypeEnvExtended -> IO ()
 printTypes = putStrLn . showTypes
 showTypeErrors :: [TypeError] -> String
 showTypeErrors errs = unlines [ show ss ++ ": " ++ msg | (msg, ss) <- sortBy (comparing snd) errs ]

src/Language/Fortran/Analysis/Types.hs

@@ -2,8 +2,11 @@ module Language.Fortran.Analysis.Types
   ( analyseTypes
   , analyseTypesWithEnv
   , analyseAndCheckTypesWithEnv
+  , stripExtended
   , extractTypeEnv
+  , extractTypeEnvExtended
   , TypeEnv
+  , TypeEnvExtended
   , TypeError
   , deriveSemTypeFromDeclaration
   , deriveSemTypeFromTypeSpec
@@ -36,6 +39,11 @@ import Language.Fortran.Version (FortranVersion(..))
 
 -- | Mapping of names to type information.
 type TypeEnv = M.Map Name IDType
+-- | Mapping of names to type information with more information about the source
+type TypeEnvExtended = M.Map Name (Name, SrcSpan, IDType)
+
+stripExtended :: TypeEnvExtended -> TypeEnv
+stripExtended = M.map (\(_, _, t) -> t)
 
 -- | Information about a detected type error.
 type TypeError = (String, SrcSpan)
@@ -121,6 +129,24 @@ extractTypeEnv pf = M.union puEnv expEnv
                                   , let n = varName e
                                   , ty <- maybeToList (idType (getAnnotation e)) ]
 
+extractTypeEnvExtended :: forall a. Data a => ProgramFile (Analysis a) -> TypeEnvExtended
+extractTypeEnvExtended pf = M.union puEnv expEnv
+  where
+    puEnv = M.fromList [ (n, (srcName, getSpan pu, ty)) | pu <- universeBi pf :: [ProgramUnit (Analysis a)]
+                                 , Named n <- [puName pu]
+                                 , Named srcName <- [puSrcName pu]
+                                 , ty <- maybeToList (idType (getAnnotation pu)) ]
+    expEnv = M.fromList [ (n, (srcName e, sp, ty)) | e@(ExpValue _ _ ValVariable{}) <- universeBi pf :: [Expression (Analysis a)]
+                                  , let n = varName e
+                                  , sp <- getDeclarator n
+                                  , ty <- maybeToList (idType (getAnnotation e)) ]
+    getDeclarator v' =
+        [ sp | d@(Declarator _ sp ev _ _ _) <- universeBi pf :: [Declarator (Analysis a)]
+             , varName ev == v' ]
+
+
+
+
 type TransType f g a = (f (Analysis a) -> Infer (f (Analysis a))) -> g (Analysis a) -> Infer (g (Analysis a))
 annotateTypes :: Data a => ProgramFile (Analysis a) -> Infer (ProgramFile (Analysis a))
 annotateTypes pf = (transformBiM :: Data a => TransType Expression ProgramFile a) annotateExpression pf >>=

src/Language/Fortran/Transformation/Monad.hs

@@ -9,6 +9,7 @@ module Language.Fortran.Transformation.Monad
 import Prelude hiding (lookup)
 import Control.Monad.State.Lazy hiding (state)
 import Data.Data
+import qualified Data.Map as M
 
 import Language.Fortran.Analysis
 import Language.Fortran.Analysis.Types
@@ -22,13 +23,14 @@ type Transform a = State (TransformationState a)
 
 runTransform
     :: Data a
-    => TypeEnv -> ModuleMap -> Transform a () -> ProgramFile a -> ProgramFile a
+    => TypeEnvExtended -> ModuleMap -> Transform a () -> ProgramFile a -> ProgramFile a
 runTransform env mmap trans pf =
     stripAnalysis . transProgramFile . execState trans $ initState
   where
-    (pf', _) = analyseTypesWithEnv env . analyseRenamesWithModuleMap mmap . initAnalysis $ pf
+    (pf', _) = analyseTypesWithEnv (removeExtendedInfo env) . analyseRenamesWithModuleMap mmap . initAnalysis $ pf
     initState = TransformationState
       { transProgramFile = pf' }
+    removeExtendedInfo = M.map (\(_, _, t) -> t)
 
 getProgramFile :: Transform a (ProgramFile (Analysis a))
 getProgramFile = gets transProgramFile

src/Language/Fortran/Util/ModFile.hs

@@ -120,7 +120,7 @@ data ModFile = ModFile { mfFilename    :: String
                        , mfStringMap   :: StringMap
                        , mfModuleMap   :: FAR.ModuleMap
                        , mfDeclMap     :: DeclMap
-                       , mfTypeEnv     :: FAT.TypeEnv
+                       , mfTypeEnv     :: FAT.TypeEnvExtended
                        , mfParamVarMap :: ParamVarMap
                        , mfOtherData   :: M.Map String LB.ByteString
                       }
@@ -145,7 +145,7 @@ emptyModFile = ModFile "" M.empty M.empty M.empty M.empty M.empty M.empty
 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
+                        , mfTypeEnv     = FAT.extractTypeEnvExtended pf
                         , mfParamVarMap = extractParamVarMap pf
                         , mfFilename    = F.pfGetFilename pf }
 
@@ -227,7 +227,7 @@ localisedModuleMap = M.map (M.filter (not . FA.isImported . snd))
 
 -- | Extract the combined module map from a set of ModFiles. Useful
 -- for parsing a Fortran file in a large context of other modules.
-combinedTypeEnv :: ModFiles -> FAT.TypeEnv
+combinedTypeEnv :: ModFiles -> FAT.TypeEnvExtended
 combinedTypeEnv = M.unions . map mfTypeEnv
 
 -- | Extract the combined declaration map from a set of

src/Language/Fortran/Util/Position.hs

@@ -26,7 +26,10 @@ instance Binary Position
 instance NFData Position
 
 instance Show Position where
-  show (Position _ c l _ _) = show l ++ ':' : show c
+  -- Column number decrement by 1 as the lexer generates column numbers
+  -- starting at position 1
+  -- See PR https://github.com/camfort/fortran-src/pull/292
+  show (Position _ c l _ _) = show l ++ ':' : show (c - 1)
 
 initPosition :: Position
 initPosition = Position