diff --git a/app/Main.hs b/app/Main.hs index 78913118..6b84bfd4 100644 --- a/app/Main.hs +++ b/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 ] diff --git a/src/Language/Fortran/Analysis/Types.hs b/src/Language/Fortran/Analysis/Types.hs index 536255cb..83e7c8ab 100644 --- a/src/Language/Fortran/Analysis/Types.hs +++ b/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 >>= diff --git a/src/Language/Fortran/Transformation/Monad.hs b/src/Language/Fortran/Transformation/Monad.hs index a3c8add3..f2bc3670 100644 --- a/src/Language/Fortran/Transformation/Monad.hs +++ b/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 diff --git a/src/Language/Fortran/Util/ModFile.hs b/src/Language/Fortran/Util/ModFile.hs index ab08138a..9079a180 100644 --- a/src/Language/Fortran/Util/ModFile.hs +++ b/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 diff --git a/src/Language/Fortran/Util/Position.hs b/src/Language/Fortran/Util/Position.hs index bf41f375..af2b3dc3 100644 --- a/src/Language/Fortran/Util/Position.hs +++ b/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