camfort 1.0 → 1.0.1
raw patch · 13 files changed
+76/−97 lines, 13 filesdep ~binarydep ~bytestringdep ~deepseqnew-uploader
Dependency ranges changed: binary, bytestring, deepseq, ghc-prim, lens, parallel, pipes, time, verifiable-expressions, vinyl
Files
- CHANGELOG.md +7/−0
- camfort.cabal +22/−24
- src/Camfort/Analysis/ModFile.hs +2/−7
- src/Language/Fortran/Model/Op/Core/Eval.hs +7/−9
- src/Language/Fortran/Model/Op/Meta.hs +4/−3
- src/Language/Fortran/Model/Singletons.hs +7/−0
- src/Language/Fortran/Model/Translate.hs +8/−7
- src/Language/Fortran/Model/Types.hs +4/−4
- src/Language/Fortran/Model/Vars.hs +8/−7
- tests/Camfort/Specification/Stencils/CheckSpec.hs +5/−7
- tests/Camfort/Specification/StencilsSpec.hs +2/−2
- tests/fixtures/Specification/Units/complexity0.f90 +0/−7
- tests/fixtures/Specification/Units/literal-prop.f90 +0/−20
CHANGELOG.md view
@@ -1,3 +1,10 @@+## 1.0.1 (March 08, 2021)++* Update fortran-src, verifiable-expressions versions+* Require minimum Vinyl 0.9 (`RMap` etc. type classes)+* Support at least GHC 8.6, 8.8, 8.10 (on Linux)+* Fix an issue caused by SBV version update+ ## 1.0 (August 29, 2019) * Update to new fortran-src version 0.4.0.
camfort.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 2a8d91415419eaf0c7d1532effdda9c5b02165f03a0eac6a02562949c3765671+-- hash: f20fef0bb3b68d25b23be09a7e5d81ecbc6c11a1fdbf47381807b55a5043774b name: camfort-version: 1.0+version: 1.0.1 synopsis: CamFort - Cambridge Fortran infrastructure description: CamFort is a tool for the analysis, transformation, verification of Fortran code. category: Language@@ -50,7 +50,6 @@ tests/fixtures/Specification/Stencils/example8.f tests/fixtures/Specification/Stencils/example9.expected.f tests/fixtures/Specification/Stencils/example9.f- tests/fixtures/Specification/Units/complexity0.f90 tests/fixtures/Specification/Units/do-loop1.f90 tests/fixtures/Specification/Units/do-loop2.f90 tests/fixtures/Specification/Units/eapVarApp.f90@@ -79,7 +78,6 @@ tests/fixtures/Specification/Units/literal-nonzero-inconsist5.f90 tests/fixtures/Specification/Units/literal-nonzero.f90 tests/fixtures/Specification/Units/literal-nonzero2.f90- tests/fixtures/Specification/Units/literal-prop.f90 tests/fixtures/Specification/Units/literal-zero.f90 tests/fixtures/Specification/Units/param.f90 tests/fixtures/Specification/Units/recursive1.f90@@ -182,27 +180,30 @@ src extra-libraries: flint+ build-tools:+ alex ==3.2.*+ , happy ==1.19.* build-depends: GenericPretty >=1.2.2 && <1.3 , array >=0.4 && <0.6 , base >=4.6 && <5- , binary >=0.8.3.0 && <0.9- , bytestring >=0.10 && <0.11+ , binary >=0.8.3.0 && <0.11+ , bytestring >=0.10 && <0.12 , containers >=0.5.0.0 && <0.7- , deepseq+ , deepseq >=1.4 && <1.5 , directory >=1.2 && <1.4 , fgl >=5.6 && <5.8 , filepath >=1.4 && <1.5 , fortran-src >=0.4 && <0.5- , ghc-prim >=0.3.1.0 && <0.6+ , ghc-prim >=0.3.1.0 && <0.7 , hmatrix >=0.20 && <0.21 , lattices >=2.0.0 && <2.1- , lens >=4.15.1 && <5+ , lens >=4.15.1 && <6 , matrix >=0.2.2 && <0.4 , mmorph >=1.0.9 && <2 , mtl >=2.1 && <2.3- , parallel- , pipes+ , parallel >=3.2 && <3.3+ , pipes >=4.3 && <4.4 , pretty >=1.1 && <2 , sbv >=8.0 && <9 , singletons >=2.2 && <3@@ -214,11 +215,8 @@ , transformers >=0.5.5.0 && <0.6 , uniplate >=1.6.10 && <1.7 , vector >=0.1 && <0.13- , verifiable-expressions >=0.6.0 && <0.7.0- , vinyl >=0.6 && <1.0- build-tools:- alex ==3.2.*- , happy ==1.19.*+ , verifiable-expressions >=0.6.0 && <0.8.0+ , vinyl >=0.9 && <1.0 default-language: Haskell2010 executable camfort@@ -262,12 +260,14 @@ Paths_camfort hs-source-dirs: tests+ build-tool-depends:+ hspec-discover:hspec-discover build-depends: QuickCheck >=2.8 && <3 , array >=0.4 && <0.6 , base >=4.6 && <5- , binary >=0.8.3.0 && <0.9- , bytestring >=0.10 && <0.11+ , binary >=0.8.3.0 && <0.11+ , bytestring >=0.10 && <0.12 , camfort , containers >=0.5.0.0 && <0.7 , directory >=1.2 && <2@@ -280,12 +280,10 @@ , lens >=4.15.1 && <5 , mtl >=2.1 && <2.3 , sbv >=8.0 && <9- , silently ==1.2.*+ , silently >=1.2 && <1.3 , temporary >=1.2.0.4 && <1.4 , text >=0.11.2.3 && <1.3- , time+ , time >=1.8 && <1.12 , uniplate >=1.6.10 && <1.7- , verifiable-expressions >=0.6.0 && <0.7.0- build-tool-depends:- hspec-discover:hspec-discover+ , verifiable-expressions >=0.6.0 && <0.8.0 default-language: Haskell2010
src/Camfort/Analysis/ModFile.hs view
@@ -30,15 +30,12 @@ import Control.Lens (ix, preview) import Control.Monad (forM) import Control.Monad.IO.Class-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Char (toLower) import Data.Data (Data) import Data.List ((\\)) import qualified Data.Map as Map import Data.Maybe (catMaybes)-import Data.Text.Encoding (decodeUtf8With, encodeUtf8)-import Data.Text.Encoding.Error (replace) import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (takeExtension, (</>))@@ -50,6 +47,7 @@ import qualified Language.Fortran.AST as F import qualified Language.Fortran.Parser.Any as FP import qualified Language.Fortran.Util.ModFile as FM+import Language.Fortran.Util.Files (flexReadFile) import Language.Fortran.ParserMonad (FortranVersion(..)) import Camfort.Analysis.Annotations (A, unitAnnotation)@@ -221,6 +219,7 @@ readParseSrcFile :: Maybe FortranVersion -> FM.ModFiles -> Filename -> IO (Maybe (F.ProgramFile A, SourceText)) readParseSrcFile mv mods f = do+ -- get file as ByteString, replacing non UTF-8 with space inp <- flexReadFile f let result = case mv of Nothing -> FP.fortranParserWithModFiles mods inp f@@ -228,10 +227,6 @@ case result of Right ast -> pure $ Just (fmap (const unitAnnotation) ast, inp) Left err -> print err >> pure Nothing- where- -- | Read file using ByteString library and deal with any weird characters.- flexReadFile :: String -> IO B.ByteString- flexReadFile = fmap (encodeUtf8 . decodeUtf8With (replace ' ')) . B.readFile getFortranFiles :: FileOrDir -> IO [String] getFortranFiles dir =
src/Language/Fortran/Model/Op/Core/Eval.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wall #-} @@ -47,7 +48,7 @@ evalCoreOp :: (MonadEvalFortran r m) => Op (Length args) ok -> OpSpec ok args result -> Rec CoreRepr args -> m (CoreRepr result)-evalCoreOp op opr = case opr of+evalCoreOp op = \case OSLit px x -> \_ -> primFromVal px <$> primLit px x OSNum1 _ _ p2 ->@@ -63,7 +64,7 @@ OSLookup _ -> return . runcurry lookupArr - OSDeref _ s -> return . runcurry (derefData s Proxy)+ OSDeref _ s -> return . runcurry (derefData s) -------------------------------------------------------------------------------- -- General@@ -209,16 +210,13 @@ -------------------------------------------------------------------------------- derefData- :: RElem '(fname, a) fields i- => SSymbol fname -> proxy a+ :: forall a fname fields i rname. RElem '(fname, a) fields i+ => SSymbol fname -> CoreRepr (Record rname fields) -> CoreRepr a-derefData nameSymbol valProxy (CRData _ dataRec) =- case rget (pairProxy nameSymbol valProxy) dataRec of+derefData _ (CRData _ dataRec) =+ case rget @'(fname, a) @fields dataRec of Field _ x -> x- where- pairProxy :: p1 a -> p2 b -> Proxy '(a, b)- pairProxy _ _ = Proxy -------------------------------------------------------------------------------- -- Equality of operators
src/Language/Fortran/Model/Op/Meta.hs view
@@ -24,9 +24,9 @@ import Data.Functor.Compose -import Data.Vinyl (Rec, rmap, (<<*>>))+import Data.Vinyl (Rec, RMap, RApply, rmap, (<<*>>)) import Data.Vinyl.Functor (Lift (..))-import Data.Vinyl.Lens (RElem, RecElem (rput))+import Data.Vinyl.Lens (RElem, rput) import Data.Singletons.TypeLits @@ -120,7 +120,8 @@ -------------------------------------------------------------------------------- rzip3With- :: (forall x. f x -> g x -> h x -> i x)+ :: (RMap xs, RApply xs)+ => (forall x. f x -> g x -> h x -> i x) -> Rec f xs -> Rec g xs -> Rec h xs
src/Language/Fortran/Model/Singletons.hs view
@@ -14,6 +14,13 @@ {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE CPP #-}++-- singletons-2.7 onwards requires StandaloneKindSignatures for TH functions+#if MIN_VERSION_base(4,14,0)+{-# LANGUAGE StandaloneKindSignatures #-}+#endif {-|
src/Language/Fortran/Model/Translate.hs view
@@ -107,6 +107,9 @@ import Data.Vinyl import Data.Vinyl.Functor (Const (..)) +-- TODO: use old non-typeclass Vinyl funcs for inline types I can't figure out+import qualified Data.Vinyl.Recursive as VinylRec+ import qualified Language.Fortran.Analysis as F import qualified Language.Fortran.AST as F import qualified Language.Fortran.Util.Position as F@@ -288,10 +291,8 @@ "'; actual type was '" <> describeBuilder (show actual) <> "'" ErrInvalidOpApplication (Some argTypes) ->- let descTypes- = recordToList- . rmap (Const . surround "'" . describeBuilder . pretty1)- $ argTypes+ let descTypes = VinylRec.recordToList descTypesRec+ descTypesRec = VinylRec.rmap (Const . surround "'" . describeBuilder . pretty1) argTypes surround s x = s <> x <> s in "tried to apply operator to arguments of the wrong type; arguments had types " <> mconcat (intersperse ", " descTypes)@@ -633,9 +634,9 @@ someArgs <- recSequenceSome <$> rtraverse (fmap Const . translateExpression . getConst) argAsts case someArgs of- Some (PairOf HasLength argsTranslated) -> do- let argsD = rmap (\(PairOf d _) -> d) argsTranslated- argsExpr = rmap (\(PairOf _ e) -> e) argsTranslated+ SomePair HasLength argsTranslated -> do+ let argsD = VinylRec.rmap (\(PairOf d _) -> d) argsTranslated+ argsExpr = VinylRec.rmap (\(PairOf _ e) -> e) argsTranslated MatchOpSpec opResult resultD <- case matchOpSpec operator argsD of Just x -> return x
src/Language/Fortran/Model/Types.hs view
@@ -43,7 +43,7 @@ import Data.Singletons.TypeLits import Data.Vinyl hiding (Field)-import Data.Vinyl.Functor+import Data.Vinyl.Functor hiding (Field) import Language.Expression.Pretty @@ -86,7 +86,7 @@ data D a where DPrim :: Prim p k a -> D (PrimS a) DArray :: Index i -> ArrValue a -> D (Array i a)- DData :: SSymbol name -> Rec (Field D) fs -> D (Record name fs)+ DData :: (RMap fs, RecordToList fs, RApply fs) => SSymbol name -> Rec (Field D) fs -> D (Record name fs) -------------------------------------------------------------------------------- -- * Semantic Types@@ -149,7 +149,7 @@ -- are not supported. data ArrValue a where ArrPrim :: Prim p k a -> ArrValue (PrimS a)- ArrData :: SSymbol name -> Rec (Field ArrValue) fs -> ArrValue (Record name fs)+ ArrData :: (RMap fs, RecordToList fs, RApply fs) => SSymbol name -> Rec (Field ArrValue) fs -> ArrValue (Record name fs) -- | An array with a phantom index type. Mostly used at the type-level to@@ -166,7 +166,7 @@ -- | A type of records with the given @name@ and @fields@. Mostly used at the -- type level to constrain instances of @'D' (Record name fields)@ etc. data Record name fields where- Record :: SSymbol name -> Rec (Field Identity) fields -> Record name fields+ Record :: RMap fields => SSymbol name -> Rec (Field Identity) fields -> Record name fields -------------------------------------------------------------------------------- -- * Combinators
src/Language/Fortran/Model/Vars.hs view
@@ -36,7 +36,10 @@ import Control.Lens hiding (Index, op) import Data.SBV.Dynamic+import Data.SBV (MonadSymbolic(..)) +import Control.Monad.Trans.Class (lift)+ import Data.Vinyl (rtraverse) import qualified Language.Fortran.AST as F@@ -136,10 +139,8 @@ return $ ARData valReprs arraySymbolicPrim :: (HasPrimReprHandlers r) => Prim p1 k1 i -> Prim p2 k2 a -> String -> r -> Symbolic SArr-arraySymbolicPrim _ _ _ = error "arraySymbolicPrim: bit-rotted in new SBV 8.0 version" -- do- -- k1 <- primSBVKind ixPrim- -- k2 <- primSBVKind valPrim- -- return $ newSArr (k1, k2) (\i -> nm ++ "_" ++ show i)---- pairProxy :: p1 a -> p2 b -> Proxy '(a, b)--- pairProxy _ _ = Proxy+arraySymbolicPrim ixPrim valPrim nm env = do+ k1 <- lift . return $ primSBVKind ixPrim env+ k2 <- lift . return $ primSBVKind valPrim env+ state <- symbolicEnv+ lift $ newSArr state (k1, k2) (\i -> nm ++ "_" ++ show i) Nothing
tests/Camfort/Specification/Stencils/CheckSpec.hs view
@@ -123,13 +123,11 @@ checkText :: BS.ByteString -> IO CheckResult checkText text = do- pf <- either (fail "received test input with invalid syntax") return $- fortranParser text "example"-- let pf' = getBlocks . fmap (const unitAnnotation) $ pf-- return (runChecking pf' ^?! arResult . _ARSuccess)-+ case fortranParser text "example" of+ Left x -> fail "received test input with invalid syntax"+ Right pf ->+ let pf' = getBlocks . fmap (const unitAnnotation) $ pf+ in return (runChecking pf' ^?! arResult . _ARSuccess) where runChecking = runIdentity . runAnalysisT "example" (logOutputNone True) LogInfo emptyModFiles . stencilChecking getBlocks = FAB.analyseBBlocks . FAR.analyseRenames . FA.initAnalysis . fmap SA.mkStencilAnnotation
tests/Camfort/Specification/StencilsSpec.hs view
@@ -36,7 +36,7 @@ import qualified Data.Text as Text import qualified Language.Fortran.AST as F import qualified Language.Fortran.Analysis as F-import Language.Fortran.Parser.Any (deduceVersion)+import Language.Fortran.Version (deduceFortranVersion) import Language.Fortran.Util.ModFile (emptyModFiles, ModFile) import System.Directory (listDirectory) import System.FilePath@@ -403,7 +403,7 @@ assertStencilSynthDir expected dir fileName testComment = let input = testInputSources (dir </> fileName)- version = deduceVersion (dir </> fileName)+ version = deduceFortranVersion (dir </> fileName) expectedFile = expected dir fileName in do synthExpectedSrc <- runIO $ readFile expectedFile
− tests/fixtures/Specification/Units/complexity0.f90
@@ -1,7 +0,0 @@-module complexity-contains- real function g(x, y)- real :: x, y, z- g = (x*x*x*x*x*x + y*y*y*y)- end function g-end module complexity
− tests/fixtures/Specification/Units/literal-prop.f90
@@ -1,20 +0,0 @@-module foo-real, parameter :: one = 1.0-contains- function f(x)- real :: x- f = x + one- end function f-- subroutine s()- !- = unit C/K :: k2c- !- = unit C :: zeroc- real, parameter :: zeroc = 273.0, k2c- !- = unit c :: tc_1_in- !- = unit k :: t- real :: tc_1_in, t-- tc_1_in = (k2c*t - zeroc)- end subroutine s- -end module foo