diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## 1.2.0 (Oct 12, 2022) + +* Improve CLI help behaviour +* Update to fortran-src 0.11.0 +* Support GHC 9.0, 9.2, 9.4 +* Dropped support for GHC 8.10 and older + ## 1.1.2 (Oct 09, 2021) Meta update to provide a release to tie new platform builds to. diff --git a/camfort.cabal b/camfort.cabal --- a/camfort.cabal +++ b/camfort.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: camfort -version: 1.1.2 +version: 1.2.0 synopsis: CamFort - Cambridge Fortran infrastructure description: CamFort is a tool for the analysis, transformation, verification of Fortran code. category: Language @@ -23,7 +23,7 @@ license-file: LICENSE build-type: Simple tested-with: - GHC >= 8.4 + GHC == 9.0, GHC == 9.2, GHC == 9.4 extra-source-files: tests/fixtures/Specification/Stencils/example10.expected.f tests/fixtures/Specification/Stencils/example10.f @@ -185,8 +185,8 @@ extra-libraries: flint build-tools: - alex ==3.2.* - , happy ==1.19.* + alex >=3.1 + , happy >=1.19 build-depends: GenericPretty >=1.2.2 && <1.3 , array >=0.4 && <0.6 @@ -195,11 +195,11 @@ , bytestring >=0.10 && <0.12 , containers >=0.5.0.0 && <0.7 , deepseq ==1.4.* - , directory >=1.2 && <1.4 - , fgl >=5.6 && <5.8 + , directory >=1.2 && <2 + , fgl >=5.6 && <5.9 , filepath ==1.4.* - , fortran-src ==0.6.* - , ghc-prim >=0.3.1.0 && <0.8 + , fortran-src >=0.11.0 && <0.12 + , ghc-prim >=0.3.1.0 && <0.10 , hmatrix ==0.20.* , lattices >=2.0.0 && <2.1 , lens >=4.15.1 && <6 @@ -209,17 +209,19 @@ , parallel ==3.2.* , pipes ==4.3.* , pretty >=1.1 && <2 - , sbv >=8.0 && <9 - , singletons >=2.2 && <2.8 + , sbv >=8.0 && <10 + , singletons >=3.0 && <3.2 + , singletons-base >=3.0 && <3.2 + , singletons-th >=3.0 && <3.2 , strict >=0.3.2 && <1 , syb >=0.4 && <0.8 , syz ==0.2.* , template-haskell >=2.11 && <3 - , text >=0.11.2.3 && <1.3 + , text >=0.11.2.3 && <2.1 , transformers >=0.5.5.0 && <0.6 , uniplate >=1.6.10 && <1.7 , vector >=0.1 && <0.13 - , verifiable-expressions >=0.6.0 && <0.8.0 + , verifiable-expressions >=0.6.2 && <0.8.0 , vinyl >=0.9 && <1.0 default-language: Haskell2010 @@ -227,11 +229,25 @@ main-is: src/Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.6 && <5 + array >=0.4 && <0.6 + , base >=4.6 && <5 + , binary >=0.8.3.0 && <0.11 + , bytestring >=0.10 && <0.12 , camfort + , containers >=0.5.0.0 && <0.7 , directory >=1.2 && <2 - , fortran-src ==0.6.* - , optparse-applicative >=0.14 && <0.16 + , fgl >=5.6 && <5.9 + , filepath ==1.4.* + , fortran-src >=0.11.0 && <0.12 + , hmatrix ==0.20.* + , lattices >=2.0.0 && <2.1 + , lens >=4.15.1 && <6 + , mtl >=2.1 && <2.3 + , optparse-applicative >=0.14 && <0.18 + , sbv >=8.0 && <10 + , text >=0.11.2.3 && <2.1 + , uniplate >=1.6.10 && <1.7 + , verifiable-expressions >=0.6.2 && <0.8.0 default-language: Haskell2010 test-suite spec @@ -275,19 +291,19 @@ , camfort , containers >=0.5.0.0 && <0.7 , directory >=1.2 && <2 - , fgl >=5.6 && <5.8 + , fgl >=5.6 && <5.9 , filepath ==1.4.* - , fortran-src ==0.6.* + , fortran-src >=0.11.0 && <0.12 , hmatrix ==0.20.* , hspec >=2.2 && <3 , lattices >=2.0.0 && <2.1 - , lens >=4.15.1 && <5.1 + , lens >=4.15.1 && <6 , mtl >=2.1 && <2.3 - , sbv >=8.0 && <9 + , sbv >=8.0 && <10 , silently ==1.2.* , temporary >=1.2.0.4 && <1.4 - , text >=0.11.2.3 && <1.3 - , time >=1.8 && <1.12 + , text >=0.11.2.3 && <2.1 + , time >=1.8 && <1.13 , uniplate >=1.6.10 && <1.7 - , verifiable-expressions >=0.6.0 && <0.8.0 + , verifiable-expressions >=0.6.2 && <0.8.0 default-language: Haskell2010 diff --git a/src/Camfort/Analysis/Annotations.hs b/src/Camfort/Analysis/Annotations.hs --- a/src/Camfort/Analysis/Annotations.hs +++ b/src/Camfort/Analysis/Annotations.hs @@ -39,7 +39,7 @@ import qualified Language.Fortran.AST as F import qualified Language.Fortran.Analysis as FA -import Language.Fortran.ParserMonad (FortranVersion(Fortran90)) +import Language.Fortran.Version (FortranVersion(Fortran90)) import qualified Language.Fortran.Util.Position as FU type A = Annotation diff --git a/src/Camfort/Analysis/CommentAnnotator.hs b/src/Camfort/Analysis/CommentAnnotator.hs --- a/src/Camfort/Analysis/CommentAnnotator.hs +++ b/src/Camfort/Analysis/CommentAnnotator.hs @@ -16,6 +16,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} module Camfort.Analysis.CommentAnnotator ( annotateComments @@ -26,7 +27,7 @@ import Data.Data (Data) -import Data.Generics.Uniplate.Operations +import Data.Generics.Uniplate.Data import Language.Fortran.AST import Language.Fortran.Util.Position @@ -63,26 +64,6 @@ writeAST a b srcSpan comment writeASTBlocks b = pure b - -- | Link all comments to first non-comment in the list. - joinComments [ ] = [ ] - joinComments dss@(d:ds) - | isComment d = - let (comments, rest) = span isComment dss - -- Given a list of comments and a list of non-comment blocks which occur - -- afterward in the code, then link them together (either forward or backward) - -- returning a pair of processed blocks and unprocessed blocks - - -- pre-condition: first parameter is a list of comments - - -- default uses 'link' to associate every comment to the first following block - linkMulti = (map (fmap $ flip linker (head rest)) comments, rest) - in if null rest -- Does the group end with comments - then comments - else let (procs, unprocs) = linkMulti - in procs ++ joinComments unprocs - | otherwise = descendBi joinComments d - : joinComments ds - {-| Link all comment blocks to first non-comment block in the list. |-} linkBlocks :: (Data a, Linkable a) => [ Block a ] -> [ Block a ] linkBlocks = joinComments @@ -90,6 +71,28 @@ {-| Link all comment 'program units' to first non-comment program unit in the list. |-} linkProgramUnits :: (Data a, Linkable a) => [ ProgramUnit a ] -> [ ProgramUnit a ] linkProgramUnits = joinComments + +-- | Link all comments to first non-comment in the list. +joinComments + :: forall f a. (HasComment (f a), Linked f, Linkable a, Functor f, Data (f a)) + => [f a] -> [f a] +joinComments [ ] = [ ] +joinComments dss@(d:ds) + | isComment d = + let (comments, rest) = span isComment dss + -- Given a list of comments and a list of non-comment blocks which occur + -- afterward in the code, then link them together (either forward or backward) + -- returning a pair of processed blocks and unprocessed blocks + + -- pre-condition: first parameter is a list of comments + + -- default uses 'link' to associate every comment to the first following block + linkMulti = (map (fmap $ flip linker (head rest)) comments, rest) + in if null rest -- Does the group end with comments + then comments + else let (procs, unprocs) = linkMulti + in procs ++ joinComments unprocs + | otherwise = descendBi @(f a) @[f a] joinComments d : joinComments ds class ASTEmbeddable a ast where annotateWithAST :: a -> ast -> a 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 @@ -45,10 +45,11 @@ import qualified Language.Fortran.Analysis.Renaming as FAR import qualified Language.Fortran.Analysis.Types as FAT import qualified Language.Fortran.AST as F -import qualified Language.Fortran.Parser.Any as FP +import qualified Language.Fortran.Parser as FP import qualified Language.Fortran.Util.ModFile as FM import Language.Fortran.Util.Files (flexReadFile) -import Language.Fortran.ParserMonad (FortranVersion(..)) +import Language.Fortran.Version (FortranVersion(..) + ,deduceFortranVersion) import Camfort.Analysis.Annotations (A, unitAnnotation) import Camfort.Helpers @@ -221,12 +222,12 @@ 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 - Just v -> FP.fortranParserWithModFilesAndVersion v mods inp f - case result of + case FP.byVerWithMods mods v f inp of Right ast -> pure $ Just (fmap (const unitAnnotation) ast, inp) Left err -> print err >> pure Nothing + where + v = case mv of Just v' -> v' + Nothing -> deduceFortranVersion f getFortranFiles :: FileOrDir -> IO [String] getFortranFiles dir = diff --git a/src/Camfort/Analysis/Simple.hs b/src/Camfort/Analysis/Simple.hs --- a/src/Camfort/Analysis/Simple.hs +++ b/src/Camfort/Analysis/Simple.hs @@ -50,6 +50,7 @@ import Data.Text (unlines, intercalate, pack) import Data.List (sort, nub, nubBy, tails) import GHC.Generics +import qualified Data.List.NonEmpty as NE import Data.Graph.Inductive @@ -395,15 +396,17 @@ getMissingUse excls (F.BlDo _ _ _ _ _ _ bs _) = concatMap (getMissingUse excls) bs getMissingUse excls (F.BlDoWhile _ _ _ _ _ _ bs _) = concatMap (getMissingUse excls) bs getMissingUse excls (F.BlForall _ _ _ _ _ bs _) = concatMap (getMissingUse excls) bs - getMissingUse excls b@(F.BlIf F.Analysis{F.insLabel = Just i} _ _ _ mes bss _) + getMissingUse excls b@(F.BlIf F.Analysis{F.insLabel = Just i} _ss _l _nm clauses mBlockElse _ml) -- check If statement conditions - | any (eligible i (length excls)) es = bads ++ rest - | otherwise = rest + | any (eligible i (length excls)) conds = bads ++ rest + | otherwise = rest where - es = catMaybes mes + clauses' = NE.toList clauses + conds = map fst clauses' + blocks = mcons mBlockElse $ map snd clauses' -- find any induction variables that are referenced by If-Elseif expressions excl' = getExcludes b - rest = concatMap (getMissingUse (excls ++ excl')) $ concat bss + rest = concatMap (getMissingUse (excls ++ excl')) $ concat blocks bads = getMissingUse' excls b getMissingUse excls b@(F.BlCase F.Analysis{F.insLabel = Just i} _ _ _ e _ bss _) -- check Case statement scrutinee @@ -478,6 +481,11 @@ let reports = map checkPU (universeBi pf'') return $!! mconcat reports + +-- | /O(1)/. Maybe cons. Borrowed from Agda. +-- @mcons ma as = maybeToList ma ++ as@ +mcons :: Maybe a -> [a] -> [a] +mcons ma as = maybe as (:as) ma -- Look through a piece of AST for the source name of a given var name. findSrcName :: forall a. Data a => F.Name -> F.Block (F.Analysis a) -> Maybe F.Name diff --git a/src/Camfort/Functionality.hs b/src/Camfort/Functionality.hs --- a/src/Camfort/Functionality.hs +++ b/src/Camfort/Functionality.hs @@ -96,7 +96,7 @@ import qualified Language.Fortran.Analysis as FA import qualified Language.Fortran.Analysis.ModGraph as FM import qualified Language.Fortran.Analysis.Renaming as FA -import Language.Fortran.ParserMonad (FortranVersion(..)) +import Language.Fortran.Version (FortranVersion(..)) import qualified Language.Fortran.Util.ModFile as FM import Pipes import qualified Pipes.Prelude as P diff --git a/src/Camfort/Input.hs b/src/Camfort/Input.hs --- a/src/Camfort/Input.hs +++ b/src/Camfort/Input.hs @@ -41,7 +41,7 @@ import qualified Language.Fortran.AST as F import Language.Fortran.Util.ModFile (ModFiles, emptyModFiles) -import Language.Fortran.ParserMonad (FortranVersion(..)) +import Language.Fortran.Version (FortranVersion(..)) import Camfort.Analysis import Camfort.Analysis.Annotations diff --git a/src/Camfort/Output.hs b/src/Camfort/Output.hs --- a/src/Camfort/Output.hs +++ b/src/Camfort/Output.hs @@ -34,7 +34,7 @@ import qualified Language.Fortran.AST as F import qualified Language.Fortran.PrettyPrint as PP import qualified Language.Fortran.Util.Position as FU -import qualified Language.Fortran.ParserMonad as FPM +import Language.Fortran.Version ( FortranVersion ) import Camfort.Analysis.Annotations import Camfort.Reprint @@ -125,21 +125,21 @@ (uses generic query extension - remember extQ is non-symmetric) -} refactoring :: Typeable a - => FPM.FortranVersion + => FortranVersion -> a -> SourceText -> StateT FU.Position Identity (SourceText, Bool) refactoring v z inp = ((catchAll inp `extQ` refactoringsForProgramUnits v inp) `extQ` refactoringsForBlocks v inp) $ z where catchAll :: SourceText -> a -> StateT FU.Position Identity (SourceText, Bool) catchAll _ _ = return (B.empty, False) -refactoringsForProgramUnits :: FPM.FortranVersion +refactoringsForProgramUnits :: FortranVersion -> SourceText -> F.ProgramUnit Annotation -> StateT FU.Position Identity (SourceText, Bool) refactoringsForProgramUnits v inp z = mapStateT (\n -> Identity $ n `evalState` 0) (refactorProgramUnits v inp z) -refactorProgramUnits :: FPM.FortranVersion +refactorProgramUnits :: FortranVersion -> SourceText -> F.ProgramUnit Annotation -> StateT FU.Position (State Int) (SourceText, Bool) @@ -155,14 +155,14 @@ refactorProgramUnits _ _ _ = return (B.empty, False) -refactoringsForBlocks :: FPM.FortranVersion +refactoringsForBlocks :: FortranVersion -> SourceText -> F.Block Annotation -> StateT FU.Position Identity (SourceText, Bool) refactoringsForBlocks v inp z = mapStateT (\n -> Identity $ n `evalState` 0) (refactorBlocks v inp z) -refactorBlocks :: FPM.FortranVersion +refactorBlocks :: FortranVersion -> SourceText -> F.Block Annotation -> StateT FU.Position (State Int) (SourceText, Bool) @@ -207,13 +207,13 @@ refactorBlocks _ _ _ = return (B.empty, False) -- Wrapper to fix the type of refactorSyntax to deal with statements -refactorStatements :: FPM.FortranVersion -> SourceText +refactorStatements :: FortranVersion -> SourceText -> F.Statement A -> StateT FU.Position (State Int) (SourceText, Bool) refactorStatements = refactorSyntax refactorSyntax :: (Typeable s, F.Annotated s, FU.Spanned (s A), PP.IndentablePretty (s A)) - => FPM.FortranVersion -> SourceText + => FortranVersion -> SourceText -> s A -> StateT FU.Position (State Int) (SourceText, Bool) refactorSyntax v inp e = do cursor <- get diff --git a/src/Camfort/Specification/DerivedDataType.hs b/src/Camfort/Specification/DerivedDataType.hs --- a/src/Camfort/Specification/DerivedDataType.hs +++ b/src/Camfort/Specification/DerivedDataType.hs @@ -352,15 +352,11 @@ where (amap, pf', tenv) = analysis mfs pf vars = S.fromList $ M.keys amap - vls1 = [ (v, S.singleton $ VInfo (FA.srcName e) srcFile ss) - | F.DeclArray _ ss e _ _ _ <- universeBi pf' :: [F.Declarator DA] - , let v = FA.varName e - , v `S.member` vars ] - vls2 = [ (v, S.singleton $ VInfo (FA.srcName e) srcFile ss) - | F.DeclVariable _ ss e _ _ <- universeBi pf' :: [F.Declarator DA] + vls = [ (v, S.singleton $ VInfo (FA.srcName e) srcFile ss) + | F.Declarator _ ss e _ _ _ <- universeBi pf' :: [F.Declarator DA] , let v = FA.varName e , v `S.member` vars ] - vmap = M.fromListWith S.union $ vls1 ++ vls2 + vmap = M.fromListWith S.union vls specs = [ (spec, b) | DDTAnnotation { ddtSpec = Just spec, ddtBlock = Just b } <- universeBi pf' ] @@ -535,8 +531,8 @@ -- FIXME: character length, what to do decl' ddAList | dds <- F.aStrip ddAList - , null dds = F.DeclVariable (F.getAnnotation decl) (FU.getSpan decl) (declExp decl) Nothing Nothing - | otherwise = F.DeclArray (F.getAnnotation decl) (FU.getSpan decl) (declExp decl) ddAList Nothing Nothing + , null dds = F.Declarator (F.getAnnotation decl) (FU.getSpan decl) (declExp decl) F.ScalarDecl Nothing Nothing + | otherwise = F.Declarator (F.getAnnotation decl) (FU.getSpan decl) (declExp decl) (F.ArrayDecl ddAList) Nothing Nothing -- The list of attributes minus any dimension attributes. attrs' = descendBi (List.filter (not . isAttrDimension)) attrs @@ -557,8 +553,8 @@ dimDeclAList = F.AList a ss $ drop dim dimList' eachLabel (_, lab') | maxDim' == dim && - dim < length dimList' = F.DeclArray a ss (FA.genVar a ss lab') dimDeclAList Nothing mInit - | otherwise = F.DeclVariable a ss (FA.genVar a ss lab') Nothing mInit + dim < length dimList' = F.Declarator a ss (FA.genVar a ss lab') (F.ArrayDecl dimDeclAList) Nothing mInit + | otherwise = F.Declarator a ss (FA.genVar a ss lab') F.ScalarDecl Nothing mInit labelDecls = map eachLabel . sort $ IM.toList essLabelMap in [ F.BlStatement a'' ss' Nothing (F.StType stA stSS Nothing tyName) , F.BlStatement a'' ss' Nothing (F.StDeclaration stA stSS nextTy attrs'' (F.AList alA alSS labelDecls)) @@ -638,8 +634,7 @@ F.BlStatement a ss _ F.StDeclaration{} | vars <- ofInterest b -> genComment vars ++ [b] where ofInterest b' = filter (flip M.member amap . fst) $ - [ (FA.varName e, FA.srcName e) | F.DeclVariable _ _ e _ _ <- universeBi b' :: [F.Declarator DA] ] ++ - [ (FA.varName e, FA.srcName e) | F.DeclArray _ _ e _ _ _ <- universeBi b' :: [F.Declarator DA] ] + [ (FA.varName e, FA.srcName e) | F.Declarator _ _ e _ _ _ <- universeBi b' :: [F.Declarator DA] ] genComment = map $ \ var -> F.BlComment newA newSS . F.Comment . buildCommentText mi space $ marker:genCommentText r var @@ -698,13 +693,11 @@ -- | Pattern matches the expression from the declarator declExp :: F.Declarator a -> F.Expression a -declExp (F.DeclVariable _ _ e _ _) = e -declExp (F.DeclArray _ _ e _ _ _) = e +declExp (F.Declarator _ _ e _ _ _) = e -- | Pattern matches the initialiser from the declarator declInitialiser :: F.Declarator a -> Maybe (F.Expression a) -declInitialiser (F.DeclVariable _ _ _ _ me) = me -declInitialiser (F.DeclArray _ _ _ _ _ me) = me +declInitialiser (F.Declarator _ _ _ _ _ me) = me -- | Given a parsed specification and variable information, attempts -- to 'distil' the essence of the specification. If there is a problem diff --git a/src/Camfort/Specification/Hoare/CheckBackend.hs b/src/Camfort/Specification/Hoare/CheckBackend.hs --- a/src/Camfort/Specification/Hoare/CheckBackend.hs +++ b/src/Camfort/Specification/Hoare/CheckBackend.hs @@ -46,6 +46,8 @@ import qualified Language.Fortran.LValue as F import qualified Language.Fortran.Util.Position as F +import qualified Data.List.NonEmpty as NE + import Camfort.Analysis import Camfort.Analysis.Logger (Builder, Text) import Camfort.Helpers.TypeLevel @@ -428,13 +430,13 @@ -- Each variable may have extra information that modifies its type info declVarsTis <- forM (F.aStrip decls) $ \case - F.DeclVariable _ _ nameExp declLength mInitialValue -> do + F.Declarator _ _ nameExp F.ScalarDecl declLength mInitialValue -> do return (nameExp, topTypeInfo & tiDeclaratorLength .~ declLength, mInitialValue) - F.DeclArray _ _ nameExp declDims declLength mInitialValue -> + F.Declarator _ _ nameExp (F.ArrayDecl declDims) declLength mInitialValue -> do return (nameExp, topTypeInfo & tiDeclaratorLength .~ declLength @@ -530,9 +532,15 @@ genBlock :: FortranTriplet (F.Block HA) -> GenM () genBlock (precond, postcond, bl) = do case bl of - F.BlIf _ _ _ _ conds bodies _ -> do - condsExprs <- traverse (traverse tryTranslateBoolExpr) conds - multiIfVCs genBody expr (precond, postcond, (zip condsExprs bodies)) + F.BlIf _ _ _ _ clauses mElseBlock _ -> do + clauses' <- flip traverse clauses $ \(cond, block) -> + tryTranslateBoolExpr cond >>= \cond' -> pure (Just cond', block) + let clauses'' = case mElseBlock of + Nothing -> + NE.toList clauses' + Just elseBlock -> + NE.toList clauses' ++ [(Nothing, elseBlock)] + multiIfVCs genBody expr (precond, postcond, clauses'') F.BlDoWhile _ _ _ _ _ cond body _ -> do primInvariant <- diff --git a/src/Camfort/Specification/Hoare/Parser.y b/src/Camfort/Specification/Hoare/Parser.y --- a/src/Camfort/Specification/Hoare/Parser.y +++ b/src/Camfort/Specification/Hoare/Parser.y @@ -5,6 +5,7 @@ import Control.Monad.Except import qualified Language.Fortran.AST as F +import qualified Language.Fortran.Version as F import Language.Verification import Language.Expression.Prop @@ -60,7 +61,7 @@ : decl_aux '(' TYPESPEC '::' tname ')' { AuxDecl $5 $3 } TYPESPEC :: { F.TypeSpec () } -: tquoted {% parseTypeSpec $1 } +: tquoted {% parseTypeSpec F.Fortran90 $1 } HOARE :: { PrimSpec () } @@ -90,7 +91,7 @@ | EXPR { PFExpr $1 } EXPR :: { F.Expression () } -: tquoted {% parseExpression $1 } +: tquoted {% parseExpression F.Fortran90 $1 } { diff --git a/src/Camfort/Specification/Hoare/Parser/Types.hs b/src/Camfort/Specification/Hoare/Parser/Types.hs --- a/src/Camfort/Specification/Hoare/Parser/Types.hs +++ b/src/Camfort/Specification/Hoare/Parser/Types.hs @@ -7,15 +7,21 @@ import Control.Monad.Except import Data.Data import Control.Exception -import Data.List (intercalate) +import Data.List ( intercalate ) -import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Char8 as B -import qualified Language.Fortran.AST as F -import qualified Language.Fortran.Lexer.FreeForm as F -import qualified Language.Fortran.Parser.Fortran90 as F -import qualified Language.Fortran.ParserMonad as F +import qualified Language.Fortran.AST as F +import Language.Fortran.Version ( FortranVersion(..) ) +-- for temporary definition defined in new fortran-src version, copied here +import Language.Fortran.AST ( A0, Statement ) +import Language.Fortran.Parser ( Parser, makeParserFixed, makeParserFree ) +import qualified Language.Fortran.Parser.Fixed.Fortran66 as F66 +import qualified Language.Fortran.Parser.Fixed.Fortran77 as F77 +import qualified Language.Fortran.Parser.Free.Fortran90 as F90 +import qualified Language.Fortran.Parser.Free.Fortran95 as F95 +import qualified Language.Fortran.Parser.Free.Fortran2003 as F2003 data HoareParseError = UnmatchedQuote @@ -89,22 +95,46 @@ deriving (Show, Eq, Ord, Typeable, Data) -- TODO: Make this report errors and deal with source position better -parseExpression :: String -> HoareSpecParser (F.Expression ()) -parseExpression expr = - case F.runParse F.statementParser parseState of - F.ParseOk (F.StExpressionAssign _ _ _ e) _ -> return e - _ -> throwError (MalformedExpression expr) +parseExpression :: FortranVersion -> String -> HoareSpecParser (F.Expression ()) +parseExpression v strExpr = + case byVerStmt v "" paddedBsExpr of + Right (F.StExpressionAssign _ _ _ e) -> return e + _ -> throwError (MalformedExpression strExpr) where - paddedExpr = B.pack $ " a = " ++ expr - parseState = F.initParseState paddedExpr F.Fortran90 "" + paddedBsExpr = B.pack $ " a = " ++ strExpr -- TODO: Make this report errors and deal with source position better -parseTypeSpec :: String -> HoareSpecParser (F.TypeSpec ()) -parseTypeSpec ts = - case F.runParse F.statementParser parseState of - F.ParseOk (F.StDeclaration _ _ s _ _) _ -> return s - _ -> throwError (MalformedTypeSpec ts) +parseTypeSpec :: FortranVersion -> String -> HoareSpecParser (F.TypeSpec ()) +parseTypeSpec v strTs = + case byVerStmt v "" paddedBsTs of + Right (F.StDeclaration _ _ s _ _) -> return s + _ -> throwError (MalformedTypeSpec strTs) where - paddedTS = B.pack $ ts ++ " :: dummy" - parseState = F.initParseState paddedTS F.Fortran90 "" + paddedBsTs = B.pack $ strTs ++ " :: dummy" + +-------------------------------------------------------------------------------- + +f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform, f77lStmtNoTransform, + f90StmtNoTransform, f95StmtNoTransform, f2003StmtNoTransform + :: Parser (Statement A0) +f66StmtNoTransform = makeParserFixed F66.statementParser Fortran66 +f77StmtNoTransform = makeParserFixed F77.statementParser Fortran77 +f77eStmtNoTransform = makeParserFixed F77.statementParser Fortran77Extended +f77lStmtNoTransform = makeParserFixed F77.statementParser Fortran77Legacy +f90StmtNoTransform = makeParserFree F90.statementParser Fortran90 +f95StmtNoTransform = makeParserFree F95.statementParser Fortran95 +f2003StmtNoTransform = makeParserFree F2003.statementParser Fortran2003 + +byVerStmt :: FortranVersion -> Parser (Statement A0) +byVerStmt = \case + Fortran66 -> f66StmtNoTransform + Fortran77 -> f77StmtNoTransform + Fortran77Extended -> f77eStmtNoTransform + Fortran77Legacy -> f77lStmtNoTransform + Fortran90 -> f90StmtNoTransform + Fortran95 -> f95StmtNoTransform + Fortran2003 -> f2003StmtNoTransform + v -> error $ "Language.Fortran.Parser.byVerStmt: " + <> "no parser available for requested version: " + <> show v diff --git a/src/Camfort/Specification/Stencils/Generate.hs b/src/Camfort/Specification/Stencils/Generate.hs --- a/src/Camfort/Specification/Stencils/Generate.hs +++ b/src/Camfort/Specification/Stencils/Generate.hs @@ -243,7 +243,7 @@ convIxToNeighbour :: (Data a) => [Variable] -> F.Index (FA.Analysis a) -> Neighbour convIxToNeighbour _ (F.IxRange _ _ Nothing Nothing Nothing) = Neighbour "" 0 convIxToNeighbour _ (F.IxRange _ _ Nothing Nothing - (Just (F.ExpValue _ _ (F.ValInteger "1")))) = Neighbour "" 0 + (Just (F.ExpValue _ _ (F.ValInteger "1" _)))) = Neighbour "" 0 convIxToNeighbour ivs (F.IxSingle _ _ _ expr) = expToNeighbour ivs expr convIxToNeighbour _ _ = NonNeighbour -- indexing expression is a range @@ -285,7 +285,7 @@ | iname `elem` ["modulo", "mod", "amod", "dmod"] -- We expect that the first parameter to modulo is being treated -- as an IxSingle element - , Just (F.Argument _ _ _ e':_) <- fmap F.aStrip subs = e' + , arg@F.Argument{} : _ <- F.aStrip subs = F.argExprNormalize (F.argumentExpr arg) replaceModulo e = e genRHSsubscripts' b = @@ -315,7 +315,7 @@ expToNeighbour ivs (F.ExpBinary _ _ F.Addition e@(F.ExpValue _ _ (F.ValVariable _)) - (F.ExpValue _ _ (F.ValInteger offs))) + (F.ExpValue _ _ (F.ValInteger offs _))) | FA.varName e `elem` ivs = Neighbour (FA.varName e) (read offs) -- use constant-expression analysis if available @@ -326,7 +326,7 @@ , Just (FAD.ConstInt offs) <- FA.constExp (F.getAnnotation e2) = Neighbour (FA.varName e1) (fromIntegral offs) expToNeighbour ivs (F.ExpBinary _ _ F.Addition - (F.ExpValue _ _ (F.ValInteger offs)) + (F.ExpValue _ _ (F.ValInteger offs _)) e@(F.ExpValue _ _ (F.ValVariable _))) | FA.varName e `elem` ivs = Neighbour (FA.varName e) (read offs) @@ -340,7 +340,7 @@ expToNeighbour ivs (F.ExpBinary _ _ F.Subtraction e@(F.ExpValue _ _ (F.ValVariable _)) - (F.ExpValue _ _ (F.ValInteger offs))) + (F.ExpValue _ _ (F.ValInteger offs _))) | FA.varName e `elem` ivs = Neighbour (FA.varName e) (if x < 0 then abs x else (- x)) where x = read offs @@ -348,7 +348,7 @@ expToNeighbour ivs expr = -- Record when there is some kind of relative index on an inducion variable -- but that is not a neighbourhood index by our definitions - if null ivs' then Constant (F.ValInteger "0") else NonNeighbour + if null ivs' then Constant (F.ValInteger "0" Nothing) else NonNeighbour where -- set of all induction variables involved in this expression ivs' = [i | e@(F.ExpValue _ _ F.ValVariable{}) @@ -443,7 +443,7 @@ cmp (Constant _) n@Neighbour{} = Just n cmp NonNeighbour{} Neighbour{} = Nothing cmp Neighbour{} NonNeighbour{} = Nothing - cmp _ _ = Just $ Constant (F.ValInteger "") + cmp _ _ = Just $ Constant (F.ValInteger "" Nothing) rhsBasis = foldrM (zipWithM cmp) (head rhses) (tail rhses) -- If there is an induction variable on the RHS, then it also occurs on -- the LHS diff --git a/src/Camfort/Specification/Stencils/Synthesis.hs b/src/Camfort/Specification/Stencils/Synthesis.hs --- a/src/Camfort/Specification/Stencils/Synthesis.hs +++ b/src/Camfort/Specification/Stencils/Synthesis.hs @@ -75,14 +75,14 @@ offsetToIx :: F.Name -> Int -> F.Index (FA.Analysis A) offsetToIx v o | o == absoluteRep - = F.IxSingle a s Nothing (F.ExpValue a s (F.ValInteger "0")) + = F.IxSingle a s Nothing (F.ExpValue a s (F.ValInteger "0" Nothing)) | o == 0 = F.IxSingle a s Nothing (F.ExpValue a s (F.ValVariable v)) | o > 0 = F.IxSingle a s Nothing (F.ExpBinary a s F.Addition (F.ExpValue a s (F.ValVariable v)) - (F.ExpValue a s (F.ValInteger $ show o))) + (F.ExpValue a s (F.ValInteger (show o) Nothing))) | otherwise = F.IxSingle a s Nothing (F.ExpBinary a s F.Subtraction (F.ExpValue a s (F.ValVariable v)) - (F.ExpValue a s (F.ValInteger $ show (abs o)))) + (F.ExpValue a s (F.ValInteger (show (abs o)) Nothing))) where a = (head $ FA.initAnalysis [unitAnnotation]) { FA.insLabel = Just 0 } s = SrcSpan (Position 0 0 0 "" Nothing) (Position 0 0 0 "" Nothing) diff --git a/src/Camfort/Specification/Units/Analysis.hs b/src/Camfort/Specification/Units/Analysis.hs --- a/src/Camfort/Specification/Units/Analysis.hs +++ b/src/Camfort/Specification/Units/Analysis.hs @@ -58,7 +58,7 @@ import qualified Language.Fortran.Analysis.SemanticTypes as FAS import qualified Language.Fortran.Analysis.BBlocks as FAB import qualified Language.Fortran.Analysis.DataFlow as FAD -import Language.Fortran.Parser.Utils (readReal, readInteger) +import Language.Fortran.AST.Literal.Real (readRealLit, parseRealLit) import Language.Fortran.Util.ModFile import qualified Numeric.LinearAlgebra as H -- for debugging import Prelude hiding (mod) @@ -327,10 +327,12 @@ where -- Follow the LitMixed rules. expMixed e = case e of - F.ExpValue _ _ (F.ValInteger i) | readInteger i == Just 0 -> withLiterals genParamLit e - | otherwise -> withLiterals genUnitLiteral e - F.ExpValue _ _ (F.ValReal i) | readReal i == Just 0 -> withLiterals genParamLit e - | otherwise -> withLiterals genUnitLiteral e + F.ExpValue _ _ (F.ValInteger i _) + | read i == 0 -> withLiterals genParamLit e + | otherwise -> withLiterals genUnitLiteral e + F.ExpValue _ _ (F.ValReal i _) + | readRealLit i == 0.0 -> withLiterals genParamLit e + | otherwise -> withLiterals genUnitLiteral e F.ExpBinary a s op e1 e2 | op `elem` [F.Multiplication, F.Division] -> case () of @@ -373,20 +375,20 @@ -- | Is it a literal, literally? isLiteral :: F.Expression UA -> Bool -isLiteral (F.ExpValue _ _ (F.ValReal _)) = True -isLiteral (F.ExpValue _ _ (F.ValInteger _)) = True +isLiteral (F.ExpValue _ _ F.ValReal{}) = True +isLiteral (F.ExpValue _ _ F.ValInteger{}) = True -- allow propagated constants to be interpreted as literals isLiteral e = isJust (constExp (F.getAnnotation e)) -- | Is expression a literal and is it non-zero? isLiteralNonZero :: F.Expression UA -> Bool -isLiteralNonZero (F.ExpValue _ _ (F.ValInteger i)) = readInteger i /= Just 0 -isLiteralNonZero (F.ExpValue _ _ (F.ValReal i)) = readReal i /= Just 0 +isLiteralNonZero (F.ExpValue _ _ (F.ValInteger i _)) = read i /= 0 +isLiteralNonZero (F.ExpValue _ _ (F.ValReal i _)) = readRealLit i /= 0.0 -- allow propagated constants to be interpreted as literals isLiteralNonZero e = case constExp (F.getAnnotation e) of Just (FA.ConstInt i) -> i /= 0 - Just (FA.ConstUninterpInt s) -> readInteger s /= Just 0 - Just (FA.ConstUninterpReal s) -> readReal s /= Just 0 + Just (FA.ConstUninterpInt s) -> read s /= 0 + Just (FA.ConstUninterpReal s) -> readRealLit (parseRealLit s) /= 0.0 _ -> False isLiteralZero :: F.Expression UA -> Bool @@ -606,14 +608,10 @@ setF2C f u1 u2 = pure . UA.maybeSetUnitInfo u1 $ UA.maybeSetUnitConstraintF2 f u1 u2 e propagateFunctionCall :: F.Expression UA -> UnitSolver (F.Expression UA) -propagateFunctionCall (F.ExpFunctionCall a s f Nothing) = do - (info, _) <- callHelper f [] - let cons = intrinsicHelper info f [] - pure . UA.setConstraint (ConConj cons) . UA.setUnitInfo info $ F.ExpFunctionCall a s f Nothing -propagateFunctionCall (F.ExpFunctionCall a s f (Just (F.AList a' s' args))) = do +propagateFunctionCall (F.ExpFunctionCall a s f (F.AList a' s' args)) = do (info, args') <- callHelper f args let cons = intrinsicHelper info f args' - pure . UA.setConstraint (ConConj cons) . UA.setUnitInfo info $ F.ExpFunctionCall a s f (Just (F.AList a' s' args')) + pure . UA.setConstraint (ConConj cons) . UA.setUnitInfo info $ F.ExpFunctionCall a s f (F.AList a' s' args') propagateFunctionCall _ = error "received non-function-call in propagateFunctionCall" propagateDoSpec :: F.DoSpecification UA -> UnitSolver (F.DoSpecification UA) @@ -640,17 +638,16 @@ propagateStatement :: F.Statement UA -> UnitSolver (F.Statement UA) propagateStatement stmt = case stmt of F.StExpressionAssign _ _ e1 e2 -> literalAssignmentSpecialCase e1 e2 stmt - F.StCall a s sub (Just (F.AList a' s' args)) -> do + F.StCall a s sub (F.AList a' s' args) -> do (info, args') <- callHelper sub args let cons = intrinsicHelper info sub args' - pure . UA.setConstraint (ConConj cons) $ F.StCall a s sub (Just (F.AList a' s' args')) + pure . UA.setConstraint (ConConj cons) $ F.StCall a s sub (F.AList a' s' args') F.StDeclaration {} -> transformBiM propagateDeclarator stmt _ -> pure stmt propagateDeclarator :: F.Declarator UA -> UnitSolver (F.Declarator UA) propagateDeclarator decl = case decl of - F.DeclVariable _ _ e1 _ (Just e2) -> literalAssignmentSpecialCase e1 e2 decl - F.DeclArray _ _ e1 _ _ (Just e2) -> literalAssignmentSpecialCase e1 e2 decl + F.Declarator _ _ e1 _ _ (Just e2) -> literalAssignmentSpecialCase e1 e2 decl _ -> pure decl -- Allow literal assignment to overload the non-polymorphic @@ -810,8 +807,8 @@ constantExpression expr = fnumToDouble <$> ce expr where ce e = case e of - (F.ExpValue _ _ (F.ValInteger i)) -> FInt <$> readInteger i - (F.ExpValue _ _ (F.ValReal r)) -> FReal <$> readReal r + (F.ExpValue _ _ (F.ValInteger i _)) -> Just $ FInt $ read i + (F.ExpValue _ _ (F.ValReal r _)) -> Just $ FReal $ readRealLit r (F.ExpBinary _ _ F.Addition e1 e2) -> liftM2 fAdd (ce e1) (ce e2) (F.ExpBinary _ _ F.Subtraction e1 e2) -> liftM2 fSub (ce e1) (ce e2) (F.ExpBinary _ _ F.Multiplication e1 e2) -> liftM2 fMul (ce e1) (ce e2) diff --git a/src/Camfort/Specification/Units/Analysis/Infer.hs b/src/Camfort/Specification/Units/Analysis/Infer.hs --- a/src/Camfort/Specification/Units/Analysis/Infer.hs +++ b/src/Camfort/Specification/Units/Analysis/Infer.hs @@ -79,9 +79,8 @@ puInfo = M.fromList [ (eiVName ei, ei) | ei <- declVariableNamesPU ] declVariableNamesDecl :: [ExpInfo] declVariableNamesDecl = flip mapMaybe (universeBi pf :: [F.Declarator UA]) $ \ d -> case d of - F.DeclVariable _ ss v@(F.ExpValue _ _ (F.ValVariable _)) _ _ -> Just (ExpInfo ss (FA.varName v) (FA.srcName v)) - F.DeclArray _ ss v@(F.ExpValue _ _ (F.ValVariable _)) _ _ _ -> Just (ExpInfo ss (FA.varName v) (FA.srcName v)) - _ -> Nothing + F.Declarator _ ss v@(F.ExpValue _ _ (F.ValVariable _)) _ _ _ -> Just (ExpInfo ss (FA.varName v) (FA.srcName v)) + _ -> Nothing declVariableNamesPU :: [ExpInfo] declVariableNamesPU = flip mapMaybe (universeBi pf :: [F.ProgramUnit UA]) $ \ pu -> case pu of F.PUFunction _ ss _ _ _ _ (Just v@(F.ExpValue _ _ (F.ValVariable _))) _ _ -> Just (ExpInfo ss (FA.varName v) (FA.srcName v)) diff --git a/src/Camfort/Specification/Units/Environment.hs b/src/Camfort/Specification/Units/Environment.hs --- a/src/Camfort/Specification/Units/Environment.hs +++ b/src/Camfort/Specification/Units/Environment.hs @@ -46,7 +46,7 @@ import Data.Binary import Data.Char import Data.Data -import Data.Generics.Uniplate.Operations (rewrite) +import Data.Generics.Uniplate.Data (rewrite) import Data.List import qualified Data.Map.Strict as M import Data.Ratio diff --git a/src/Camfort/Specification/Units/ModFile.hs b/src/Camfort/Specification/Units/ModFile.hs --- a/src/Camfort/Specification/Units/ModFile.hs +++ b/src/Camfort/Specification/Units/ModFile.hs @@ -97,8 +97,7 @@ [ FA.varName e | F.BlInterface _ _ (Just e) _ _ _ <- universeBi pf :: [F.Block UA] ] let puVarNameSet pu = S.fromList $ - [ (FA.varName v, FA.srcName v) | F.DeclVariable _ _ v _ _ <- universeBi pu :: [F.Declarator UA] ] ++ - [ (FA.varName v, FA.srcName v) | F.DeclArray _ _ v _ _ _ <- universeBi pu :: [F.Declarator UA] ] + [ (FA.varName v, FA.srcName v) | F.Declarator _ _ v _ _ _ <- universeBi pu :: [F.Declarator UA] ] -- Map of modules -> associated declared variables let puVarNameMap :: M.Map F.ProgramUnitName (S.Set VV) diff --git a/src/Camfort/Transformation/CommonBlockElim.hs b/src/Camfort/Transformation/CommonBlockElim.hs --- a/src/Camfort/Transformation/CommonBlockElim.hs +++ b/src/Camfort/Transformation/CommonBlockElim.hs @@ -43,7 +43,7 @@ import qualified Language.Fortran.Analysis.SemanticTypes as FAS import qualified Language.Fortran.Analysis.Renaming as FAR import qualified Language.Fortran.Analysis.Types as FAT -import qualified Language.Fortran.ParserMonad as PM +import qualified Language.Fortran.Version as F import qualified Language.Fortran.PrettyPrint as PP import qualified Language.Fortran.Util.Position as FU import Prelude hiding (mod, init) @@ -83,7 +83,7 @@ logDebug' pfs $ describe $ r ++ r' pure (pfs'', pfM) where - meta = F.MetaInfo PM.Fortran90 "" + meta = F.MetaInfo F.Fortran90 "" analyseAndRmCommons :: [F.ProgramFile A] -> CommonState [F.ProgramFile A] @@ -124,17 +124,7 @@ modify (\(r, infos) -> (r ++ r', info : infos)) typeCommonExprs :: F.Declarator A1 -> (F.Name, TypeInfo) - typeCommonExprs = \case - F.DeclVariable _ sp nameExpr _ _ -> - let var = FA.varName nameExpr - src = FA.srcName nameExpr - in case M.lookup var tenv of - Just (FA.IDType (Just t) (Just ct@FA.CTVariable)) -> (src, (t, ct)) - Just (FA.IDType (Just t) (Just ct@FA.CTArray{})) -> (src, (t, ct)) - _ -> error $ "Variable '" ++ src - ++ "' is of an unknown or higher-order type at: " - ++ show sp ++ " " ++ show (M.lookup var tenv) - F.DeclArray _ sp nameExpr _ _ _ -> + typeCommonExprs (F.Declarator _ sp nameExpr _ _ _) = let var = FA.varName nameExpr src = FA.srcName nameExpr in case M.lookup var tenv of @@ -256,7 +246,7 @@ inames (F.StInclude _ _ (F.ExpValue _ _ (F.ValString fname)) _) = Just fname inames _ = Nothing - importIncludeCommons :: PM.FortranVersion -> F.ProgramUnit A -> F.ProgramUnit A + importIncludeCommons :: F.FortranVersion -> F.ProgramUnit A -> F.ProgramUnit A importIncludeCommons v p = foldl' (flip (matchPUnit v)) p (reduceCollect inames p) @@ -273,7 +263,7 @@ where insertUses' :: [F.Block A] -> [F.Block A] insertUses' bs = uses ++ bs - matchPUnit :: PM.FortranVersion -> Filename -> F.ProgramUnit A -> F.ProgramUnit A + matchPUnit :: F.FortranVersion -> Filename -> F.ProgramUnit A -> F.ProgramUnit A matchPUnit v fname p = removeDecls v (map snd tcrs') p' where @@ -294,7 +284,7 @@ -- Given the list of renamed/coercerd variables form common blocks, -- remove any declaration sites - removeDecls :: PM.FortranVersion -> [RenamerCoercer] -> F.ProgramUnit A -> F.ProgramUnit A + removeDecls :: F.FortranVersion -> [RenamerCoercer] -> F.ProgramUnit A -> F.ProgramUnit A removeDecls v rcs p = addToProgramUnit v p' remainingAssignments where (p', remainingAssignments) = runState (transformBiM (removeDecl rcs) p) [] @@ -321,10 +311,9 @@ matchVar :: ([F.Statement A], [F.Declarator A]) -> F.Declarator A -> ([F.Statement A], [F.Declarator A]) - -- match on variable or array declaration + -- match on declaration (care not whether scalar or array) matchVar (assgnsNew, declsNew) dec = case dec of - F.DeclVariable _ _ lvar@(F.ExpValue _ _ (F.ValVariable v)) _ init -> doMatchVar lvar v init - F.DeclArray _ _ lvar@(F.ExpValue _ _ (F.ValVariable v)) _ _ init -> doMatchVar lvar v init + F.Declarator _ _ lvar@(F.ExpValue _ _ (F.ValVariable v)) _ _ init -> doMatchVar lvar v init _ -> (assgnsNew, declsNew) where doMatchVar lvar v init @@ -341,7 +330,7 @@ -- Adds additional statements to the start of the statement block in a program unit addToProgramUnit :: - PM.FortranVersion -> F.ProgramUnit A -> [F.Statement A] -> F.ProgramUnit A + F.FortranVersion -> F.ProgramUnit A -> [F.Statement A] -> F.ProgramUnit A addToProgramUnit v pu stmnts = descendBi (addAfterDecls (map toBlock stmnts)) pu where -- Find the point where blocks are non-executable statements @@ -449,10 +438,10 @@ | af ty1 == af ty2 = let (r', c) = coherentCommons' xs ys in (r', c && True) | otherwise = let r = var1 ++ ":" - ++ PP.pprintAndRender PM.Fortran90 (fst ty1) Nothing + ++ PP.pprintAndRender F.Fortran90 (fst ty1) Nothing ++ "(" ++ show (af ty1) ++ ")" ++ " differs from " ++ var2 - ++ ":" ++ PP.pprintAndRender PM.Fortran90 (fst ty2) Nothing + ++ ":" ++ PP.pprintAndRender F.Fortran90 (fst ty2) Nothing ++ "(" ++ show (af ty2) ++ ")" ++ "\n" (r', _) = coherentCommons' xs ys in (r ++ r', False) @@ -476,7 +465,7 @@ r = "Creating module " ++ modname ++ " at " ++ path ++ "\n" mod = mkModule (F.miVersion meta) modname varTys modname -mkModule :: PM.FortranVersion -> String -> [(F.Name, TypeInfo)] -> String -> F.ProgramUnit A +mkModule :: F.FortranVersion -> String -> [(F.Name, TypeInfo)] -> String -> F.ProgramUnit A mkModule v name vtys fname = F.PUModule a sp (caml fname) decls Nothing where @@ -488,13 +477,13 @@ attrs = Just $ F.AList a sp [F.AttrSave a sp] typespec = FAS.recoverSemTypeTypeSpec a sp v toDeclarator (v, FA.CTVariable) = F.AList a sp - [F.DeclVariable a sp - (F.ExpValue a sp (F.ValVariable (caml name ++ "_" ++ v))) Nothing Nothing] + [F.Declarator a sp + (F.ExpValue a sp (F.ValVariable (caml name ++ "_" ++ v))) F.ScalarDecl Nothing Nothing] toDeclarator (v, FA.CTArray dims) = F.AList a sp - [F.DeclArray a sp - (F.ExpValue a sp (F.ValVariable (caml name ++ "_" ++ v))) dimDecls Nothing Nothing] + [F.Declarator a sp + (F.ExpValue a sp (F.ValVariable (caml name ++ "_" ++ v))) (F.ArrayDecl dimDecls) Nothing Nothing] where dimDecls = F.AList a sp . flip map dims $ \ (lb, ub) -> F.DimensionDeclarator a sp (fmap expr lb) (fmap expr ub) - expr = F.ExpValue a sp . F.ValInteger . show + expr x = F.ExpValue a sp $ F.ValInteger (show x) Nothing toDeclarator (_, ct) = error $ "mkModule: toDeclarator: bad construct type: " ++ show ct decls = map toDeclBlock vtys diff --git a/src/Camfort/Transformation/EquivalenceElim.hs b/src/Camfort/Transformation/EquivalenceElim.hs --- a/src/Camfort/Transformation/EquivalenceElim.hs +++ b/src/Camfort/Transformation/EquivalenceElim.hs @@ -36,6 +36,8 @@ import qualified Language.Fortran.Analysis.Types as FAT (analyseTypes, TypeEnv) import qualified Language.Fortran.Util.Position as FU +import qualified Debug.Trace + type EquivalenceRefactoring = PureAnalysis Void Void type A1 = FA.Analysis Annotation @@ -81,33 +83,34 @@ -- Find all variables/cells that are equivalent to the target -- of this assignment eqs <- equivalentsToExpr dstE - -- If there is only one, then it must refer to itself, so do nothing - if length eqs <= 1 - then return [b] - -- If there are more than one, copy statements must be generated - else do - (equivs, n) <- get + Debug.Trace.trace (show (length eqs)) $ + -- If there is only one, then it must refer to itself, so do nothing + if length eqs <= 1 + then return [b] + -- If there are more than one, copy statements must be generated + else do + (equivs, n) <- get - -- Remove the destination from the equivalents - let eqs' = deleteBy (\ x y -> af x == af y) dstE eqs + -- Remove the destination from the equivalents + let eqs' = deleteBy (\ x y -> af x == af y) dstE eqs - -- Make copy statements - let pos = afterAligned sp - let copies = map (mkCopy tenv pos dstE) eqs' + -- Make copy statements + let pos = afterAligned sp + let copies = map (mkCopy tenv pos dstE) eqs' - let (FU.Position ao c l f p) = s1 - reportSpan i = - let pos' = FU.Position (ao + i) c (l + i) f p - in (FU.SrcSpan pos' pos') + let (FU.Position ao c l f p) = s1 + reportSpan i = + let pos' = FU.Position (ao + i) c (l + i) f p + in (FU.SrcSpan pos' pos') - forM_ [n..(n + length copies - 1)] $ \i -> do - origin <- atSpanned (reportSpan i) - logInfo origin $ "added copy due to refactored equivalence" + forM_ [n..(n + length copies - 1)] $ \i -> do + origin <- atSpanned (reportSpan i) + logInfo origin $ "added copy due to refactored equivalence" - -- Update refactoring state - put (equivs, n + length eqs') - -- Sequence original assignment with new assignments - return $ b : copies + -- Update refactoring state + put (equivs, n + length eqs') + -- Sequence original assignment with new assignments + return $ b : copies addCopysPerBlock tenv x = do x' <- descendBiM (addCopysPerBlockGroup tenv) x @@ -139,8 +142,8 @@ where call = F.ExpFunctionCall a sp transf argst transf = F.ExpValue a sp (F.ValVariable "transfer") - argst = Just (F.AList a sp args) - args = map (F.Argument a sp Nothing) [srcE', dstE'] + argst = F.AList a sp args + args = map (F.Argument a sp Nothing . F.ArgExpr) [srcE', dstE'] -- Types are equal, simple a assignment Just _ -> F.StExpressionAssign a sp dstE' srcE' where diff --git a/src/Language/Fortran/Model/Op/Core.hs b/src/Language/Fortran/Model/Op/Core.hs --- a/src/Language/Fortran/Model/Op/Core.hs +++ b/src/Language/Fortran/Model/Op/Core.hs @@ -8,6 +8,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} @@ -27,8 +28,13 @@ import Data.Functor.Compose +#if MIN_VERSION_singletons(3,0,0) +import Data.List.Singletons +import GHC.TypeLits.Singletons +#else import Data.Singletons.Prelude.List import Data.Singletons.TypeLits +#endif import Data.Vinyl import Data.Vinyl.Curry diff --git a/src/Language/Fortran/Model/Op/Core/Core.hs b/src/Language/Fortran/Model/Op/Core/Core.hs --- a/src/Language/Fortran/Model/Op/Core/Core.hs +++ b/src/Language/Fortran/Model/Op/Core/Core.hs @@ -6,13 +6,18 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} -- TODO: Function calls module Language.Fortran.Model.Op.Core.Core where +#if MIN_VERSION_singletons(3,0,0) +import GHC.TypeLits.Singletons +#else import Data.Singletons.TypeLits +#endif import Data.Vinyl 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 @@ -12,6 +12,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} @@ -25,9 +26,14 @@ import Data.SBV.Dynamic (SVal) import qualified Data.SBV.Dynamic as SBV +#if MIN_VERSION_singletons(3,0,0) +import Data.List.Singletons +import GHC.TypeLits.Singletons +#else import Data.Singletons import Data.Singletons.Prelude.List import Data.Singletons.TypeLits +#endif import Data.Vinyl hiding (Field) import Data.Vinyl.Curry diff --git a/src/Language/Fortran/Model/Op/Core/Match.hs b/src/Language/Fortran/Model/Op/Core/Match.hs --- a/src/Language/Fortran/Model/Op/Core/Match.hs +++ b/src/Language/Fortran/Model/Op/Core/Match.hs @@ -10,6 +10,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} @@ -22,8 +23,12 @@ import Control.Lens +#if MIN_VERSION_singletons(3,0,0) +import Data.List.Singletons +#else import Data.Singletons import Data.Singletons.Prelude.List +#endif import Data.Vinyl hiding ((:~:), Field) 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 @@ -8,6 +8,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} @@ -28,7 +29,12 @@ import Data.Vinyl.Functor (Lift (..)) import Data.Vinyl.Lens (RElem, rput) + +#if MIN_VERSION_singletons(3,0,0) +import GHC.TypeLits.Singletons +#else import Data.Singletons.TypeLits +#endif import qualified Data.SBV.Dynamic as SBV diff --git a/src/Language/Fortran/Model/Repr/Prim.hs b/src/Language/Fortran/Model/Repr/Prim.hs --- a/src/Language/Fortran/Model/Repr/Prim.hs +++ b/src/Language/Fortran/Model/Repr/Prim.hs @@ -204,8 +204,9 @@ primReprHandlers :: r -> PrimReprHandlers primReprHandlers env = PrimReprHandlers (primReprHandler env) + -- note that we must eta expand due to GHC 9.0 simplified subsumption primReprHandler :: r -> Prim p k a -> PrimReprHandler a - primReprHandler = unPrimReprHandlers . primReprHandlers + primReprHandler r p = unPrimReprHandlers (primReprHandlers r) p newtype PrimReprHandlers = PrimReprHandlers { unPrimReprHandlers :: forall p k a. Prim p k a -> PrimReprHandler a } 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 @@ -18,7 +18,7 @@ {-# LANGUAGE CPP #-} -- singletons-2.7 onwards requires StandaloneKindSignatures for TH functions -#if MIN_VERSION_base(4,14,0) +#if MIN_VERSION_singletons(2,7,0) {-# LANGUAGE StandaloneKindSignatures #-} #endif @@ -56,7 +56,13 @@ -} module Language.Fortran.Model.Singletons where +#if MIN_VERSION_singletons(3,0,0) +import Prelude.Singletons +import Data.Ord.Singletons +#else import Data.Singletons.Prelude +#endif + import Data.Singletons.TH $(singletons 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 @@ -101,8 +101,13 @@ import Control.Monad.Reader import Data.Map (Map) +#if MIN_VERSION_singletons(3,0,0) import Data.Singletons +import Data.List.Singletons (Length) +#else +import Data.Singletons import Data.Singletons.Prelude.List (Length) +#endif import Data.Vinyl import Data.Vinyl.Functor (Const (..)) @@ -112,6 +117,7 @@ import qualified Language.Fortran.Analysis as F import qualified Language.Fortran.AST as F +import Language.Fortran.AST.Literal.Real (readRealLit) import qualified Language.Fortran.Util.Position as F import Language.Expression @@ -423,10 +429,7 @@ kindInt <- case mkind of Nothing -> return 0 - Just (F.ExpValue _ _ (F.ValInteger s)) -> - case readLitInteger s of - Just k -> return k - Nothing -> throwError ErrBadLiteral + Just (F.ExpValue _ _ (F.ValInteger s _)) -> return $ read s _ -> unsupported "kind which isn't an integer literal" let getKindPrec btName ksl = do @@ -541,11 +544,14 @@ -- annotations of its own. -- -- Do not call on an expression that you don't know to be an 'F.ExpValue'! +-- +-- Note that we ignore potential type information in the form of the optional +-- kind parameter for some values. translateValue :: (Monad m, MonadFail m) => F.Expression (F.Analysis ann) -> TranslateT m SomeExpr translateValue e = case e of F.ExpValue _ _ v -> case v of - F.ValInteger s -> translateLiteral v PInt64 (fmap fromIntegral . readLitInteger) s - F.ValReal s -> translateLiteral v PFloat (fmap realToFrac . readLitReal) s + F.ValInteger s _ -> translateLiteral v PInt64 (Just . read) s + F.ValReal s _ -> translateLiteral v PFloat (Just . readRealLit) s -- TODO: Auxiliary variables F.ValVariable nm -> do @@ -555,19 +561,19 @@ Just (Some v'@(FortranVar d _)) -> return (SomePair d (HPure v')) _ -> throwError $ ErrVarNotInScope nm - F.ValLogical s -> - let intoBool = fmap (\b -> if b then Bool8 1 else Bool8 0) . readLitBool - in translateLiteral v PBool8 intoBool s + F.ValLogical s _ -> + let intoBool b = if b then Bool8 1 else Bool8 0 + in translateLiteral v PBool8 (Just . intoBool) s - F.ValComplex r c -> unsupported "complex literal" - F.ValString s -> unsupported "string literal" - F.ValHollerith s -> unsupported "hollerith literal" - F.ValIntrinsic nm -> unsupported $ "intrinsic " <> describe nm - F.ValOperator s -> unsupported "user-defined operator" - F.ValAssignment -> unsupported "interface assignment" - F.ValType s -> unsupported "type value" - F.ValStar -> unsupported "star value" - F.ValColon -> unsupported "colon value" + F.ValComplex{} -> unsupported "complex literal" + F.ValString{} -> unsupported "string literal" + F.ValHollerith{} -> unsupported "hollerith literal" + F.ValIntrinsic nm -> unsupported $ "intrinsic " <> describe nm + F.ValOperator{} -> unsupported "user-defined operator" + F.ValAssignment{} -> unsupported "interface assignment" + F.ValType{} -> unsupported "type value" + F.ValStar{} -> unsupported "star value" + F.ValColon{} -> unsupported "colon value" _ -> fail "impossible: translateValue called on a non-value" @@ -670,19 +676,3 @@ Just x -> return x Nothing -> unsupported "unary operator" translateOpApp operator (Const e :& RNil) - --------------------------------------------------------------------------------- --- Readers for things that are strings in the AST --------------------------------------------------------------------------------- - -readLitInteger :: String -> Maybe Integer -readLitInteger = readMaybe - -readLitReal :: String -> Maybe Double -readLitReal = readMaybe - -readLitBool :: String -> Maybe Bool -readLitBool l = case map toLower l of - ".true." -> Just True - ".false." -> Just False - _ -> Nothing 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 @@ -9,6 +9,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} @@ -40,7 +41,11 @@ import Data.Typeable (Typeable) import Data.Word (Word8) +#if MIN_VERSION_singletons(3,0,0) +import GHC.TypeLits.Singletons +#else import Data.Singletons.TypeLits +#endif import Data.Vinyl hiding (Field) import Data.Vinyl.Functor hiding (Field) diff --git a/src/Language/Fortran/Model/Types/Match.hs b/src/Language/Fortran/Model/Types/Match.hs --- a/src/Language/Fortran/Model/Types/Match.hs +++ b/src/Language/Fortran/Model/Types/Match.hs @@ -10,6 +10,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} @@ -20,8 +21,13 @@ import Data.Typeable import Data.Singletons -import Data.Singletons.TypeLits import GHC.TypeLits + +#if MIN_VERSION_singletons(3,0,0) +import GHC.TypeLits.Singletons +#else +import Data.Singletons.TypeLits +#endif import Data.Vinyl hiding ((:~:), Field) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -25,7 +25,7 @@ import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import GHC.Stack -import Language.Fortran.ParserMonad (FortranVersion(..), selectFortranVersion) +import Language.Fortran.Version (FortranVersion(..), selectFortranVersion) import Options.Applicative import System.Directory (getCurrentDirectory) import System.Exit @@ -43,7 +43,7 @@ realMain :: IO () realMain = do currentDir <- getCurrentDirectory - cmd <- execParser (info (commandParser currentDir) idm) + cmd <- customExecParser (prefs showHelpOnEmpty) (info (commandParser currentDir) idm) code <- runCommand cmd if code == 0 then exitWith ExitSuccess @@ -457,9 +457,9 @@ commandAlias alias cmdParser = command alias . info cmdParser $ mempty -- | Helper for building a parser for a group of commands. -commandsParser :: String -> [(String, [String], Parser Command, String)] -> Parser Command -commandsParser groupName commands = - hsubparser (mconcat (fmap +commandsParser :: String -> String -> [(String, [String], Parser Command, String)] -> Parser Command +commandsParser mv groupName commands = + hsubparser (metavar mv <> mconcat (fmap (\(name, _, cmdParser, description) -> (command name . info cmdParser . progDesc $ description)) commands) @@ -473,7 +473,7 @@ <> internal analysesParser :: Parser Command -analysesParser = commandsParser "Analysis Commands" analysesCommands +analysesParser = commandsParser "ANALYSIS_COMMAND" "Analysis Commands" analysesCommands where analysesCommands = [ ("count", @@ -534,7 +534,7 @@ refactoringsParser :: Parser Command -refactoringsParser = commandsParser "Refactoring Commands" refactoringsCommands +refactoringsParser = commandsParser "REFACTORING_COMMAND" "Refactoring Commands" refactoringsCommands where refactoringsCommands = [ ("common", [], cmdRefactCommon, "common block elimination") @@ -542,7 +542,7 @@ , ("dead", [], cmdRefactDead, "dead-code elimination") ] derivedDatatypeParser :: Parser Command -derivedDatatypeParser = commandsParser "Derived Datatype Commands" derivedDatatypeCommands +derivedDatatypeParser = commandsParser "DDT_COMMAND" "Derived Datatype Commands" derivedDatatypeCommands where derivedDatatypeCommands = [ ("ddt-infer", ["infer-ddt"], cmdInferDDT, "infer derived datatypes") @@ -551,20 +551,18 @@ , ("ddt-refactor", ["refactor-ddt"], cmdRefactDDT, "refactor marked derived datatypes from comments") , ("ddt-compile", ["compile-ddt"], cmdCompileDDT, "compile derived datatypes info")] -topLevelCommands :: Parser Command -topLevelCommands = versionOption - where versionOption = pure CmdTopVersion <* switch - ( long "version" - <> short 'v' - <> short '?' - <> help "show version number") +showVersionParser :: Parser Command +showVersionParser = flag' CmdTopVersion $ long "version" + <> short 'v' + <> short '?' + <> help "show version number" cmdInit :: FilePath -> Parser Command cmdInit currDir = fmap CmdInit . directoryArgument $ help "project directory" <> value currDir projectParser :: FilePath -> Parser Command -projectParser currDir = commandsParser "Project Commands" projectCommands +projectParser currDir = commandsParser "PROJECT_COMMAND" "Project Commands" projectCommands where projectCommands = [ ("init", [], cmdInit currDir, "initialize CamFort for the project") ] @@ -576,12 +574,12 @@ <|> analysesParser <|> refactoringsParser <|> derivedDatatypeParser - <|> topLevelCommands) + <|> showVersionParser ) -- | Current CamFort version. version :: String -version = "1.1.2" +version = "1.2.0" -- | Full CamFort version string. diff --git a/tests/Camfort/Analysis/CommentAnnotatorSpec.hs b/tests/Camfort/Analysis/CommentAnnotatorSpec.hs --- a/tests/Camfort/Analysis/CommentAnnotatorSpec.hs +++ b/tests/Camfort/Analysis/CommentAnnotatorSpec.hs @@ -11,7 +11,7 @@ import Control.Monad.Writer.Strict import Data.Data import Language.Fortran.AST -import Language.Fortran.ParserMonad +import Language.Fortran.Version import Language.Fortran.Util.Position import Test.Hspec @@ -61,7 +61,7 @@ varGen :: Name -> Expression A varGen x = ExpValue ea p (ValVariable x) intGen :: Integer -> Expression A -intGen i = ExpValue ea p (ValInteger (show i)) +intGen i = ExpValue ea p (ValInteger (show i) Nothing) wrapBlocks :: [Block A] -> ProgramFile A wrapBlocks bs' = ProgramFile (MetaInfo { miVersion = Fortran90, miFilename = "" }) [ pu ] where diff --git a/tests/Camfort/Specification/Hoare/ParserSpec.hs b/tests/Camfort/Specification/Hoare/ParserSpec.hs --- a/tests/Camfort/Specification/Hoare/ParserSpec.hs +++ b/tests/Camfort/Specification/Hoare/ParserSpec.hs @@ -53,7 +53,7 @@ y = fvar "y" z = fvar "z" - num n = F.ExpValue () defSpan (F.ValInteger (show n)) + num n = F.ExpValue () defSpan (F.ValInteger (show n) Nothing) bin o e1 e2 = F.ExpBinary () defSpan o e1 e2 add = bin F.Addition 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 @@ -17,7 +17,7 @@ import qualified Language.Fortran.Analysis as FA import qualified Language.Fortran.Analysis.BBlocks as FAB import qualified Language.Fortran.Analysis.Renaming as FAR -import Language.Fortran.Parser.Any (fortranParser) +import Language.Fortran.Parser as FP import Language.Fortran.Util.ModFile (emptyModFiles) import Test.Hspec @@ -123,7 +123,7 @@ checkText :: BS.ByteString -> IO CheckResult checkText text = do - case fortranParser text "example" of + case FP.f90 "example" text of Left x -> fail "received test input with invalid syntax" Right pf -> let pf' = getBlocks . fmap (const unitAnnotation) $ pf 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 @@ -175,7 +175,7 @@ it "consistent (2) a(i,c,j) = b(i,j+1) + b(i,j) \ \:: forward(depth=1,dim=2)*pointed(dim=1)" $ indicesToSpec' ["i", "j"] - [Neighbour "i" 0, Constant (F.ValInteger "0"), Neighbour "j" 0] + [Neighbour "i" 0, Constant (F.ValInteger "0" Nothing), Neighbour "j" 0] [[offsetToIx "i" 0, offsetToIx "j" 1], [offsetToIx "i" 0, offsetToIx "j" 0]] `shouldBe` (Just $ Specification (Once $ Exact @@ -185,7 +185,7 @@ it "consistent (3) a(i+1,c,j) = b(j,i+1) + b(j,i) \ \:: backward(depth=1,dim=2)*pointed(dim=1)" $ indicesToSpec' ["i", "j"] - [Neighbour "i" 1, Constant (F.ValInteger "0"), Neighbour "j" 0] + [Neighbour "i" 1, Constant (F.ValInteger "0" Nothing), Neighbour "j" 0] [[offsetToIx "j" 0, offsetToIx "i" 1], [offsetToIx "j" 0, offsetToIx "i" 0]] `shouldBe` (Just $ Specification (Once $ Exact @@ -558,7 +558,7 @@ variationsRel :: [(Neighbour, Neighbour, [[Int]], Multiplicity (Approximation Spatial))] variationsRel = [ -- Stencil which has non-relative indices in one dimension - (Neighbour "i" 0, Constant (F.ValInteger "0"), [ [0, absoluteRep], [1, absoluteRep] ] + (Neighbour "i" 0, Constant (F.ValInteger "0" Nothing), [ [0, absoluteRep], [1, absoluteRep] ] , Once $ Exact $ Spatial (Sum [Product [Forward 1 1 True]]) ) , (Neighbour "i" 1, Neighbour "j" 0, [ [0,0] ] @@ -582,7 +582,7 @@ (Just (Spatial (Sum [Product [ Backward 3 1 False , Centered 0 2 True ]])))) - , (Constant (F.ValInteger "0"), Neighbour "j" 0, [ [absoluteRep,1], [absoluteRep,0], [absoluteRep,-1] ] + , (Constant (F.ValInteger "0" Nothing), Neighbour "j" 0, [ [absoluteRep,1], [absoluteRep,0], [absoluteRep,-1] ] , Once $ Exact $ Spatial (Sum [Product [Centered 1 2 True]]) ) ]