diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/camfort.cabal b/camfort.cabal --- a/camfort.cabal +++ b/camfort.cabal @@ -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 diff --git a/src/Camfort/Analysis/ModFile.hs b/src/Camfort/Analysis/ModFile.hs --- a/src/Camfort/Analysis/ModFile.hs +++ b/src/Camfort/Analysis/ModFile.hs @@ -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 = diff --git a/src/Language/Fortran/Model/Op/Core/Eval.hs b/src/Language/Fortran/Model/Op/Core/Eval.hs --- a/src/Language/Fortran/Model/Op/Core/Eval.hs +++ b/src/Language/Fortran/Model/Op/Core/Eval.hs @@ -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 diff --git a/src/Language/Fortran/Model/Op/Meta.hs b/src/Language/Fortran/Model/Op/Meta.hs --- a/src/Language/Fortran/Model/Op/Meta.hs +++ b/src/Language/Fortran/Model/Op/Meta.hs @@ -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 diff --git a/src/Language/Fortran/Model/Singletons.hs b/src/Language/Fortran/Model/Singletons.hs --- a/src/Language/Fortran/Model/Singletons.hs +++ b/src/Language/Fortran/Model/Singletons.hs @@ -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 {-| diff --git a/src/Language/Fortran/Model/Translate.hs b/src/Language/Fortran/Model/Translate.hs --- a/src/Language/Fortran/Model/Translate.hs +++ b/src/Language/Fortran/Model/Translate.hs @@ -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 diff --git a/src/Language/Fortran/Model/Types.hs b/src/Language/Fortran/Model/Types.hs --- a/src/Language/Fortran/Model/Types.hs +++ b/src/Language/Fortran/Model/Types.hs @@ -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 diff --git a/src/Language/Fortran/Model/Vars.hs b/src/Language/Fortran/Model/Vars.hs --- a/src/Language/Fortran/Model/Vars.hs +++ b/src/Language/Fortran/Model/Vars.hs @@ -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 diff --git a/tests/Camfort/Specification/Stencils/CheckSpec.hs b/tests/Camfort/Specification/Stencils/CheckSpec.hs --- a/tests/Camfort/Specification/Stencils/CheckSpec.hs +++ b/tests/Camfort/Specification/Stencils/CheckSpec.hs @@ -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 diff --git a/tests/Camfort/Specification/StencilsSpec.hs b/tests/Camfort/Specification/StencilsSpec.hs --- a/tests/Camfort/Specification/StencilsSpec.hs +++ b/tests/Camfort/Specification/StencilsSpec.hs @@ -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 diff --git a/tests/fixtures/Specification/Units/complexity0.f90 b/tests/fixtures/Specification/Units/complexity0.f90 deleted file mode 100644 --- a/tests/fixtures/Specification/Units/complexity0.f90 +++ /dev/null @@ -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 diff --git a/tests/fixtures/Specification/Units/literal-prop.f90 b/tests/fixtures/Specification/Units/literal-prop.f90 deleted file mode 100644 --- a/tests/fixtures/Specification/Units/literal-prop.f90 +++ /dev/null @@ -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