diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +### 0.8.0 (Jan 04, 2022) + * Merge declarator constructors. Now you differentiate between array and + scalar declarators by looking at the relevant field. See + `Language.Fortran.AST.Declarator` for details. + * Add `bozAsNatural :: Num a => Boz -> a` function to resolve BOZ constants as + integers + ### 0.7.0 (Dec 09, 2021) * No longer treat `!` in strings as comments in continuation reformatter (thanks @envp) #179 diff --git a/fortran-src.cabal b/fortran-src.cabal --- a/fortran-src.cabal +++ b/fortran-src.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: fortran-src -version: 0.7.0 +version: 0.8.0 synopsis: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial). description: Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, Fortran 95, Fortran 2003 (partial) and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the @@ project, which uses fortran-src as its front end. category: Language diff --git a/src/Language/Fortran/AST.hs b/src/Language/Fortran/AST.hs --- a/src/Language/Fortran/AST.hs +++ b/src/Language/Fortran/AST.hs @@ -48,8 +48,10 @@ , Name , BaseType(..) , TypeSpec(..) - , Declarator(..) , Selector(..) + , Declarator(..) + , DeclaratorType(..) + , declaratorType , DimensionDeclarator(..) -- ** Annotated node list (re-export) @@ -635,53 +637,40 @@ | ValColon -- see R402 / C403 in Fortran2003 spec. deriving (Eq, Show, Data, Typeable, Generic, Functor) --- | Declarators. +-- | Declarators. R505 entity-decl from F90 ISO spec. -- -- Declaration statements can have multiple variables on the right of the double -- colon, separated by commas. A 'Declarator' identifies a single one of these. --- --- Each declared variable can have an initializing expression. These expressions --- are defined in HP's F90 spec to be /initialization expressions/, which are --- specialized constant expressions. --- --- The length expressions here are defined in HP's F90 spec to be specifications --- expressions, which are scalar integer expressions with a bunch of --- restrictions similar to initialization expressions. --- --- 'Declarator's are also used for some less-used syntax that let you set --- variable attributes using statements, like: --- --- integer arr --- dimension arr(10) +-- In F90, they look like this: -- --- Some of these only set part of the 'Declarator' (e.g. @parameter@ only sets --- the initial value). +-- VAR_NAME ( OPT_ARRAY_DIMS ) * CHAR_LENGTH_EXPR = INIT_EXPR -- --- Syntax note: length is set like @character :: str*10@, dimensions are set --- like @integer :: arr(10)@. Careful to not get confused. +-- F77 doesn't standardize so nicely -- in particular, I'm not confident in +-- initializing expression syntax. So no example. -- --- Note that lengths may only be specified for CHARACTER types. However, a --- nonstandard syntax feature is to use this as a kind parameter for non --- CHARACTERs. So we parse length for all 'Declarator's, handle the nonstandard --- feature and print a warning during our type analysis. -data Declarator a = - DeclVariable a SrcSpan - (Expression a) -- ^ Variable - (Maybe (Expression a)) -- ^ Length (character) - (Maybe (Expression a)) -- ^ Initial value - | DeclArray a SrcSpan - (Expression a) -- ^ Array - (AList DimensionDeclarator a) -- ^ Dimensions - (Maybe (Expression a)) -- ^ Length (character) - (Maybe (Expression a)) -- ^ Initial value +-- Only CHARACTERs may specify a length. However, a nonstandard syntax feature +-- uses non-CHARACTER lengths as a kind parameter. We parse regardless of type +-- and warn during analysis. +data Declarator a + = Declarator a SrcSpan + (Expression a) -- ^ Variable + (DeclaratorType a) -- ^ Declarator type (dimensions if array) + (Maybe (Expression a)) -- ^ Length (character) + (Maybe (Expression a)) -- ^ Initial value deriving (Eq, Show, Data, Typeable, Generic, Functor) +data DeclaratorType a + = ScalarDecl + | ArrayDecl (AList DimensionDeclarator a) + deriving (Eq, Show, Data, Typeable, Generic, Functor) + +declaratorType :: Declarator a -> DeclaratorType a +declaratorType (Declarator _ _ _ dt _ _) = dt + +-- | Set a 'Declarator''s initializing expression only if it has none already. setInitialisation :: Declarator a -> Expression a -> Declarator a -setInitialisation (DeclVariable a s v l Nothing) init = - DeclVariable a (getTransSpan s init) v l (Just init) -setInitialisation (DeclArray a s v ds l Nothing) init = - DeclArray a (getTransSpan s init) v ds l (Just init) --- do nothing when there is already a value +setInitialisation (Declarator a s v dt l Nothing) init = + Declarator a (getTransSpan s init) v dt l (Just init) setInitialisation d _ = d -- | Dimension declarator stored in @dimension@ attributes and 'Declarator's. @@ -952,6 +941,7 @@ instance Out BaseType instance Out a => Out (Declarator a) instance Out a => Out (DimensionDeclarator a) +instance Out a => Out (DeclaratorType a) instance Out a => Out (ControlPair a) instance Out a => Out (AllocOpt a) instance Out UnaryOp @@ -1034,6 +1024,7 @@ instance NFData a => NFData (DataGroup a) instance NFData a => NFData (DimensionDeclarator a) instance NFData a => NFData (Declarator a) +instance NFData a => NFData (DeclaratorType a) instance NFData a => NFData (FormatItem a) instance NFData a => NFData (FlushSpec a) instance NFData a => NFData (ImpElement a) diff --git a/src/Language/Fortran/AST/Boz.hs b/src/Language/Fortran/AST/Boz.hs --- a/src/Language/Fortran/AST/Boz.hs +++ b/src/Language/Fortran/AST/Boz.hs @@ -4,9 +4,18 @@ constants are bitstrings (untyped!) which have basically no implicit rules. How they're interpreted depends on context (they are generally limited to DATA statements and a small handful of intrinsic functions). + +Note that currently, we don't store BOZ constants as bitstrings. Storing them in +their string representation is easy and in that form, they're easy to safely +resolve to an integer. An alternate option would be to store them as the +bitstring "B" of BOZ, and only implement functions on that. For simple uses +(integer), I'm doubtful that would provide extra utility or performance, but it +may be more sensible in the future. For now, you may retrieve a bitstring by +converting to a numeric type and using something like 'showIntAtBase', or a +'Bits' instance. -} -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies, DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-} {-# LANGUAGE LambdaCase #-} module Language.Fortran.AST.Boz where @@ -18,6 +27,8 @@ import qualified Data.List as List import qualified Data.Char as Char +import qualified Numeric as Num +import Data.Maybe ( isJust, fromJust ) -- | A Fortran BOZ literal constant. -- @@ -29,13 +40,15 @@ data Boz = Boz { bozPrefix :: BozPrefix , bozString :: String - } deriving (Eq, Show, Data, Typeable, Generic, NFData, Out, Ord) + } deriving stock (Eq, Show, Generic, Data, Typeable, Ord) + deriving anyclass (NFData, Out) data BozPrefix = BozPrefixB | BozPrefixO | BozPrefixZ -- also @x@ - deriving (Eq, Show, Data, Typeable, Generic, NFData, Out, Ord) + deriving stock (Eq, Show, Generic, Data, Typeable, Ord) + deriving anyclass (NFData, Out) -- | UNSAFE. Parses a BOZ literal constant string. -- @@ -69,3 +82,20 @@ BozPrefixB -> 'b' BozPrefixO -> 'o' BozPrefixZ -> 'z' + +-- | Resolve a BOZ constant as a natural (positive integer). +-- +-- Is actually polymorphic over the output type, but you probably want to +-- resolve to 'Integer' or 'Natural' usually. +bozAsNatural :: (Num a, Eq a) => Boz -> a +bozAsNatural (Boz pfx str) = runReadS $ parser str + where + runReadS = fst . head + parser = case pfx of + BozPrefixB -> -- TODO on GHC 9.2, 'Num.readBin' + Num.readInt 2 (isJust . binCharFunc) (fromJust . binCharFunc) + BozPrefixO -> Num.readOct + BozPrefixZ -> Num.readHex + binCharFunc = \case '0' -> Just 0 + '1' -> Just 1 + _ -> Nothing diff --git a/src/Language/Fortran/Analysis.hs b/src/Language/Fortran/Analysis.hs --- a/src/Language/Fortran/Analysis.hs +++ b/src/Language/Fortran/Analysis.hs @@ -301,8 +301,7 @@ lhsOfStmt (StCall _ _ _ (Just aexps)) = concatMap (match'' . extractExp) (aStrip aexps) lhsOfStmt s = onExprs s - lhsOfDecls (DeclVariable _ _ e _ (Just e')) = match' e : onExprs e' - lhsOfDecls (DeclArray _ _ e _ _ (Just e')) = match' e : onExprs e' + lhsOfDecls (Declarator _ _ e _ _ (Just e')) = match' e : onExprs e' lhsOfDecls _ = [] onExprs :: (Data (c (Analysis a))) => c (Analysis a) -> [Name] @@ -366,8 +365,7 @@ blockVarUses (BlStatement _ _ _ st@StDeclaration{}) = concat [ rhsOfDecls d | d <- universeBi st ] where rhsOfDecls :: Data a => Declarator (Analysis a) -> [Name] - rhsOfDecls (DeclVariable _ _ _ _ (Just e)) = allVars e - rhsOfDecls (DeclArray _ _ _ _ _ (Just e)) = allVars e + rhsOfDecls (Declarator _ _ _ _ _ (Just e)) = allVars e rhsOfDecls _ = [] blockVarUses (BlStatement _ _ _ (StCall _ _ f@(ExpValue _ _ (ValIntrinsic _)) _)) | Just uses <- intrinsicUses f = uses diff --git a/src/Language/Fortran/Analysis/BBlocks.hs b/src/Language/Fortran/Analysis/BBlocks.hs --- a/src/Language/Fortran/Analysis/BBlocks.hs +++ b/src/Language/Fortran/Analysis/BBlocks.hs @@ -890,15 +890,15 @@ showBaseType (ClassCustom s) = "class(" ++ s ++ ")" showDecl :: Declarator a -> String -showDecl (DeclArray _ _ e adims length' initial) = - showExpr e ++ - "(" ++ aIntercalate "," showDim adims ++ ")" ++ - maybe "" (\e' -> "*" ++ showExpr e') length' ++ - maybe "" (\e' -> " = " ++ showExpr e') initial -showDecl (DeclVariable _ _ e length' initial) = - showExpr e ++ - maybe "" (\e' -> "*" ++ showExpr e') length' ++ - maybe "" (\e' -> " = " ++ showExpr e') initial +showDecl (Declarator _ _ e mAdims length' initial) = + let partDims = case mAdims of + ScalarDecl -> mempty + ArrayDecl dims -> + "(" ++ aIntercalate "," showDim dims ++ ")" + in showExpr e + ++ partDims + ++ maybe "" (\e' -> "*" ++ showExpr e') length' + ++ maybe "" (\e' -> " = " ++ showExpr e') initial showDim :: DimensionDeclarator a -> String showDim (DimensionDeclarator _ _ me1 me2) = maybe "" ((++":") . showExpr) me1 ++ maybe "" showExpr me2 diff --git a/src/Language/Fortran/Analysis/DataFlow.hs b/src/Language/Fortran/Analysis/DataFlow.hs --- a/src/Language/Fortran/Analysis/DataFlow.hs +++ b/src/Language/Fortran/Analysis/DataFlow.hs @@ -392,10 +392,10 @@ [ (varName v, getE e) | st@(StDeclaration _ _ (TypeSpec _ _ _ _) _ _) <- universeBi pf :: [Statement (Analysis a)] , AttrParameter _ _ <- universeBi st :: [Attribute (Analysis a)] - , (DeclVariable _ _ v _ (Just e)) <- universeBi st ] ++ + , (Declarator _ _ v ScalarDecl _ (Just e)) <- universeBi st ] ++ [ (varName v, getE e) | st@StParameter{} <- universeBi pf :: [Statement (Analysis a)] - , (DeclVariable _ _ v _ (Just e)) <- universeBi st ] + , (Declarator _ _ v ScalarDecl _ (Just e)) <- universeBi st ] getV :: Expression (Analysis a) -> Maybe Constant getV e = constExp (getAnnotation e) `mplus` (join . flip M.lookup pvMap . varName $ e) diff --git a/src/Language/Fortran/Analysis/Renaming.hs b/src/Language/Fortran/Analysis/Renaming.hs --- a/src/Language/Fortran/Analysis/Renaming.hs +++ b/src/Language/Fortran/Analysis/Renaming.hs @@ -162,17 +162,12 @@ return (bs1, e0) declarator :: forall a. Data a => RenamerFunc (Declarator (Analysis a)) -declarator (DeclVariable a s e1 me2 me3) = do - e1' <- renameExpDecl e1 - me2' <- transformBiM (renameExp :: RenamerFunc (Expression (Analysis a))) me2 - me3' <- transformBiM (renameExp :: RenamerFunc (Expression (Analysis a))) me3 - return $ DeclVariable a s e1' me2' me3' -declarator (DeclArray a s e1 ddAList me2 me3) = do +declarator (Declarator a s e1 mDdAList me2 me3) = do e1' <- renameExpDecl e1 - ddAList' <- transformBiM (renameExp :: RenamerFunc (Expression (Analysis a))) ddAList + mDdAList' <- transformBiM (renameExp :: RenamerFunc (Expression (Analysis a))) mDdAList me2' <- transformBiM (renameExp :: RenamerFunc (Expression (Analysis a))) me2 me3' <- transformBiM (renameExp :: RenamerFunc (Expression (Analysis a))) me3 - return $ DeclArray a s e1' ddAList' me2' me3' + return $ Declarator a s e1' mDdAList' me2' me3' expression :: Data a => RenamerFunc (Expression (Analysis a)) expression = renameExp diff --git a/src/Language/Fortran/Analysis/Types.hs b/src/Language/Fortran/Analysis/Types.hs --- a/src/Language/Fortran/Analysis/Types.hs +++ b/src/Language/Fortran/Analysis/Types.hs @@ -97,7 +97,7 @@ -- Gather information. mapM_ intrinsicsExp (allExpressions pf) mapM_ programUnit (allProgramUnits pf) - mapM_ declarator (allDeclarators pf) + mapM_ recordArrayDecl (allDeclarators pf) mapM_ statement (allStatements pf) -- Gather types for known entry points. @@ -168,9 +168,16 @@ sequence_ [ recordEntryPoint n (varName v) Nothing | (StEntry _ _ v _ _) <- allStatements block ] programUnit _ = return () -declarator :: Data a => InferFunc (Declarator (Analysis a)) -declarator (DeclArray _ _ v ddAList _ _) = recordCType (CTArray $ dimDeclarator ddAList) (varName v) -declarator _ = return () +-- | Records array type information from a 'Declarator'. (Scalar type info is +-- processed elsewhere.) +-- +-- Note that 'ConstructType' is rewritten for 'Declarator's in +-- 'handleDeclaration' later. TODO how does this assist exactly? disabling +-- apparently doesn't impact tests +recordArrayDecl :: Data a => InferFunc (Declarator (Analysis a)) +recordArrayDecl (Declarator _ _ v (ArrayDecl ddAList) _ _) = + recordCType (CTArray $ dimDeclarator ddAList) (varName v) +recordArrayDecl _ = return () dimDeclarator :: AList DimensionDeclarator a -> [(Maybe Int, Maybe Int)] dimDeclarator ddAList = [ (lb, ub) | DimensionDeclarator _ _ lbExp ubExp <- aStrip ddAList @@ -198,13 +205,13 @@ , ct /= CTIntrinsic = ct | otherwise = CTVariable handler rs = \case - DeclArray _ declSs v ddAList mLenExpr _ -> do - st <- deriveSemTypeFromDeclaration stmtSs declSs ts mLenExpr - pure $ (varName v, st, CTArray $ dimDeclarator ddAList) : rs - DeclVariable _ declSs v mLenExpr _ -> do + Declarator _ declSs v mDdAList mLenExpr _ -> do st <- deriveSemTypeFromDeclaration stmtSs declSs ts mLenExpr - let n = varName v - pure $ (n, st, cType n) : rs + let n = varName v + ct = case mDdAList of + ScalarDecl -> cType n + ArrayDecl dims -> CTArray $ dimDeclarator dims + pure $ (n, st, ct) : rs in foldM handler [] decls handleStructureItem :: Data a => StructMemberTypeEnv -> StructureItem (Analysis a) -> Infer StructMemberTypeEnv @@ -252,8 +259,9 @@ statement (StDimension _ _ declAList) = do let decls = aStrip declAList forM_ decls $ \ decl -> case decl of - DeclArray _ _ v ddAList _ _ -> recordCType (CTArray $ dimDeclarator ddAList) (varName v) - _ -> return () + Declarator _ _ v (ArrayDecl ddAList) _ _ -> + recordCType (CTArray $ dimDeclarator ddAList) (varName v) + _ -> return () statement (StStructure _ _ mName itemAList) = handleStructure mName itemAList diff --git a/src/Language/Fortran/Parser/Fortran2003.y b/src/Language/Fortran/Parser/Fortran2003.y --- a/src/Language/Fortran/Parser/Fortran2003.y +++ b/src/Language/Fortran/Parser/Fortran2003.y @@ -673,8 +673,8 @@ -- R463 ENUMERATOR :: { Declarator A0 } -: VARIABLE '=' EXPRESSION { DeclVariable () (getTransSpan $1 $3) $1 Nothing (Just $3) } -| VARIABLE { DeclVariable () (getSpan $1) $1 Nothing Nothing } +: PARAMETER_ASSIGNMENT { $1 } +| VARIABLE { Declarator () (getSpan $1) $1 ScalarDecl Nothing Nothing } MAYBE_PROC_INTERFACE :: { Maybe (ProcInterface A0) } : TYPE_SPEC { Just $ ProcInterfaceType () (getSpan $1) $1 } @@ -1018,7 +1018,7 @@ PARAMETER_ASSIGNMENT :: { Declarator A0 } : VARIABLE '=' EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 Nothing (Just $3) } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl Nothing (Just $3) } DECLARATION_STATEMENT :: { Statement A0 } : TYPE_SPEC ATTRIBUTE_LIST '::' INITIALIZED_DECLARATOR_LIST @@ -1096,23 +1096,23 @@ | DECLARATOR { $1 } DECLARATOR :: { Declarator A0 } -: VARIABLE { DeclVariable () (getSpan $1) $1 Nothing Nothing } +: VARIABLE + { Declarator () (getSpan $1) $1 ScalarDecl Nothing Nothing } | VARIABLE '*' EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 (Just $3) Nothing } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl (Just $3) Nothing } | VARIABLE '*' '(' '*' ')' { let star = ExpValue () (getSpan $4) ValStar - in DeclVariable () (getTransSpan $1 $5) $1 (Just star) Nothing } + in Declarator () (getTransSpan $1 $5) $1 ScalarDecl (Just star) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' - { DeclArray () (getTransSpan $1 $4) $1 (aReverse $3) Nothing Nothing } + { Declarator () (getTransSpan $1 $4) $1 (ArrayDecl (aReverse $3)) Nothing Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' EXPRESSION - { DeclArray () (getTransSpan $1 $6) $1 (aReverse $3) (Just $6) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $3)) (Just $6) Nothing } -- nonstandard char array syntax (wrong order for dimensions & charlen) - | VARIABLE '*' EXPRESSION '(' DIMENSION_DECLARATORS ')' - { let star = ExpValue () (getSpan $4) ValStar - in DeclArray () (getTransSpan $1 $6) $1 (aReverse $5) (Just $3) Nothing } +| VARIABLE '*' EXPRESSION '(' DIMENSION_DECLARATORS ')' + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $5)) (Just $3) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' '(' '*' ')' { let star = ExpValue () (getSpan $7) ValStar - in DeclArray () (getTransSpan $1 $8) $1 (aReverse $3) (Just star) Nothing } + in Declarator () (getTransSpan $1 $8) $1 (ArrayDecl (aReverse $3)) (Just star) Nothing } DIMENSION_DECLARATORS :: { AList DimensionDeclarator A0 } : DIMENSION_DECLARATORS ',' DIMENSION_DECLARATOR diff --git a/src/Language/Fortran/Parser/Fortran66.y b/src/Language/Fortran/Parser/Fortran66.y --- a/src/Language/Fortran/Parser/Fortran66.y +++ b/src/Language/Fortran/Parser/Fortran66.y @@ -144,14 +144,16 @@ BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } -| {- EMPTY -} { [ ] } +| {- EMPTY -} { [ ] } BLOCK :: { Block A0 } : LABEL_IN_6COLUMN STATEMENT NEWLINE { BlStatement () (getTransSpan $1 $2) (Just $1) $2 } | STATEMENT NEWLINE { BlStatement () (getSpan $1) Nothing $1 } | comment NEWLINE { let (TComment s c) = $1 in BlComment () s (Comment c) } -MAYBE_NEWLINE :: { Maybe Token } : NEWLINE { Just $1 } | {- EMPTY -} { Nothing } +MAYBE_NEWLINE :: { Maybe Token } +: NEWLINE { Just $1 } +| {- EMPTY -} { Nothing } NEWLINE :: { Token } : NEWLINE newline { $1 } @@ -164,16 +166,22 @@ | NONEXECUTABLE_STATEMENT { $1 } LOGICAL_IF_STATEMENT :: { Statement A0 } -: if '(' EXPRESSION ')' OTHER_EXECUTABLE_STATEMENT { StIfLogical () (getTransSpan $1 $5) $3 $5 } +: if '(' EXPRESSION ')' OTHER_EXECUTABLE_STATEMENT + { StIfLogical () (getTransSpan $1 $5) $3 $5 } DO_STATEMENT :: { Statement A0 } -: do LABEL_IN_STATEMENT DO_SPECIFICATION { StDo () (getTransSpan $1 $3) Nothing (Just $2) (Just $3) } +: do LABEL_IN_STATEMENT DO_SPECIFICATION + { StDo () (getTransSpan $1 $3) Nothing (Just $2) (Just $3) } DO_SPECIFICATION :: { DoSpecification A0 } -: EXPRESSION_ASSIGNMENT_STATEMENT ',' INT_OR_VAR ',' INT_OR_VAR { DoSpecification () (getTransSpan $1 $5) $1 $3 (Just $5) } -| EXPRESSION_ASSIGNMENT_STATEMENT ',' INT_OR_VAR { DoSpecification () (getTransSpan $1 $3) $1 $3 Nothing } +: EXPRESSION_ASSIGNMENT_STATEMENT ',' INT_OR_VAR ',' INT_OR_VAR + { DoSpecification () (getTransSpan $1 $5) $1 $3 (Just $5) } +| EXPRESSION_ASSIGNMENT_STATEMENT ',' INT_OR_VAR + { DoSpecification () (getTransSpan $1 $3) $1 $3 Nothing } -INT_OR_VAR :: { Expression A0 } : INTEGER_LITERAL { $1 } | VARIABLE { $1 } +INT_OR_VAR :: { Expression A0 } +: INTEGER_LITERAL { $1 } +| VARIABLE { $1 } OTHER_EXECUTABLE_STATEMENT :: { Statement A0 } : EXPRESSION_ASSIGNMENT_STATEMENT { $1 } @@ -219,9 +227,13 @@ | '(' UNIT ',' FORM ')' { (AList () (getTransSpan $2 $4) [ ControlPair () (getSpan $2) Nothing $2, ControlPair () (getSpan $4) Nothing $4 ], Nothing) } -- Not my terminology a VAR or an INT (probably positive) is defined as UNIT. -UNIT :: { Expression A0 } : INTEGER_LITERAL { $1 } | VARIABLE { $1 } +UNIT :: { Expression A0 } +: INTEGER_LITERAL { $1 } +| VARIABLE { $1 } -FORM :: { Expression A0 } : VARIABLE { $1 } | LABEL_IN_STATEMENT { $1 } +FORM :: { Expression A0 } +: VARIABLE { $1 } +| LABEL_IN_STATEMENT { $1 } IO_ELEMENTS :: { AList Expression A0 } : IO_ELEMENTS ',' IO_ELEMENT { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1} @@ -283,34 +295,40 @@ : NAME_LIST ',' NAME_LIST_ELEMENT { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } | NAME_LIST_ELEMENT { AList () (getSpan $1) [ $1 ] } -NAME_LIST_ELEMENT :: { Expression A0 } : VARIABLE { $1 } | SUBSCRIPT { $1 } +NAME_LIST_ELEMENT :: { Expression A0 } +: VARIABLE { $1 } +| SUBSCRIPT { $1 } -- Note that declarator lists in the F66 parser don't have initializers. DECLARATORS :: { AList Declarator A0 } : DECLARATORS ',' DECLARATOR { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } | DECLARATOR { AList () (getSpan $1) [ $1 ] } --- Parses arrays as DeclVariable, otherwise we get a conflict. DECLARATOR :: { Declarator A0 } -: ARRAY_DECLARATOR { $1 } +: ARRAY_DECLARATOR { $1 } | VARIABLE_DECLARATOR { $1 } ARRAY_DECLARATORS :: { AList Declarator A0 } -: ARRAY_DECLARATORS ',' ARRAY_DECLARATOR { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } -| ARRAY_DECLARATOR { AList () (getSpan $1) [ $1 ] } +: ARRAY_DECLARATORS ',' ARRAY_DECLARATOR + { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } +| ARRAY_DECLARATOR + { AList () (getSpan $1) [ $1 ] } ARRAY_DECLARATOR :: { Declarator A0 } -: VARIABLE '(' DIMENSION_DECLARATORS ')' { DeclArray () (getTransSpan $1 $4) $1 (aReverse $3) Nothing Nothing } +: VARIABLE '(' DIMENSION_DECLARATORS ')' + { Declarator () (getTransSpan $1 $4) $1 (ArrayDecl (aReverse $3)) Nothing Nothing } DIMENSION_DECLARATORS :: { AList DimensionDeclarator A0 } -: DIMENSION_DECLARATORS ',' DIMENSION_DECLARATOR { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } -| DIMENSION_DECLARATOR { AList () (getSpan $1) [ $1 ] } +: DIMENSION_DECLARATORS ',' DIMENSION_DECLARATOR + { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } +| DIMENSION_DECLARATOR + { AList () (getSpan $1) [ $1 ] } DIMENSION_DECLARATOR :: { DimensionDeclarator A0 } : EXPRESSION { DimensionDeclarator () (getSpan $1) Nothing (Just $1) } VARIABLE_DECLARATOR :: { Declarator A0 } -: VARIABLE { DeclVariable () (getSpan $1) $1 Nothing Nothing } +: VARIABLE { Declarator () (getSpan $1) $1 ScalarDecl Nothing Nothing } -- Here the procedure should be either a function or subroutine name, but -- since they are syntactically identical at this stage subroutine names diff --git a/src/Language/Fortran/Parser/Fortran77.y b/src/Language/Fortran/Parser/Fortran77.y --- a/src/Language/Fortran/Parser/Fortran77.y +++ b/src/Language/Fortran/Parser/Fortran77.y @@ -556,7 +556,7 @@ PARAMETER_ASSIGNMENT :: { Declarator A0 } : VARIABLE '=' CONSTANT_EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 Nothing (Just $3) } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl Nothing (Just $3) } DECLARATION_STATEMENT :: { Statement A0 } : TYPE_SPEC maybe(',') INITIALIZED_DECLARATORS @@ -631,7 +631,7 @@ POINTER :: { Declarator A0 } : '(' VARIABLE ',' VARIABLE ')' - { DeclVariable () (getTransSpan $1 $5) $2 Nothing (Just $4) } + { Declarator () (getTransSpan $1 $5) $2 ScalarDecl Nothing (Just $4) } COMMON_GROUPS :: { AList CommonGroup A0 } : COMMON_GROUPS COMMON_GROUP { setSpan (getTransSpan $1 $2) $ $2 `aCons` $1 } @@ -664,16 +664,17 @@ UNINITIALIZED_ARRAY_DECLARATOR :: { Declarator A0 } : VARIABLE '(' DIMENSION_DECLARATORS ')' - { DeclArray () (getTransSpan $1 $4) $1 (aReverse $3) Nothing Nothing } + { Declarator () (getTransSpan $1 $4) $1 (ArrayDecl (aReverse $3)) Nothing Nothing } | VARIABLE '*' SIMPLE_EXPRESSION '(' DIMENSION_DECLARATORS ')' - { DeclArray () (getTransSpan $1 $6) $1 (aReverse $5) (Just $3) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $5)) (Just $3) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' SIMPLE_EXPRESSION - { DeclArray () (getTransSpan $1 $6) $1 (aReverse $3) (Just $6) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $3)) (Just $6) Nothing } UNINITIALIZED_VARIABLE_DECLARATOR :: { Declarator A0 } -: VARIABLE { DeclVariable () (getSpan $1) $1 Nothing Nothing } +: VARIABLE + { Declarator () (getSpan $1) $1 ScalarDecl Nothing Nothing } | VARIABLE '*' SIMPLE_EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 (Just $3) Nothing } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl (Just $3) Nothing } INITIALIZED_DECLARATORS :: { AList Declarator A0 } : INITIALIZED_DECLARATORS ',' INITIALIZED_DECLARATOR { setSpan (getTransSpan $1 $3) $ $3 `aCons` $1 } @@ -691,21 +692,21 @@ INITIALIZED_ARRAY_DECLARATOR :: { Declarator A0 } : UNINITIALIZED_ARRAY_DECLARATOR { $1 } | VARIABLE '(' DIMENSION_DECLARATORS ')' '/' SIMPLE_EXPRESSION_LIST '/' - { DeclArray () (getTransSpan $1 $7) $1 (aReverse $3) Nothing + { Declarator () (getTransSpan $1 $7) $1 (ArrayDecl (aReverse $3)) Nothing (Just (ExpInitialisation () (getSpan $6) (fromReverseList $6))) } | VARIABLE '*' SIMPLE_EXPRESSION '(' DIMENSION_DECLARATORS ')' '/' SIMPLE_EXPRESSION_LIST '/' - { DeclArray () (getTransSpan $1 $9) $1 (aReverse $5) (Just $3) + { Declarator () (getTransSpan $1 $9) $1 (ArrayDecl (aReverse $5)) (Just $3) (Just (ExpInitialisation () (getSpan $8) (fromReverseList $8))) } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' SIMPLE_EXPRESSION '/' SIMPLE_EXPRESSION_LIST '/' - { DeclArray () (getTransSpan $1 $9) $1 (aReverse $3) (Just $6) + { Declarator () (getTransSpan $1 $9) $1 (ArrayDecl (aReverse $3)) (Just $6) (Just (ExpInitialisation () (getSpan $8) (fromReverseList $8))) } INITIALIZED_VARIABLE_DECLARATOR :: { Declarator A0 } : UNINITIALIZED_VARIABLE_DECLARATOR { $1 } | VARIABLE '/' SIMPLE_EXPRESSION '/' - { DeclVariable () (getTransSpan $1 $4) $1 Nothing (Just $3) } + { Declarator () (getTransSpan $1 $4) $1 ScalarDecl Nothing (Just $3) } | VARIABLE '*' SIMPLE_EXPRESSION '/' SIMPLE_EXPRESSION '/' - { DeclVariable () (getTransSpan $1 $6) $1 (Just $3) (Just $5) } + { Declarator () (getTransSpan $1 $6) $1 ScalarDecl (Just $3) (Just $5) } SIMPLE_EXPRESSION_LIST :: { [Expression A0] } : SIMPLE_EXPRESSION_LIST ',' SIMPLE_EXPRESSION { $3 : $1 } diff --git a/src/Language/Fortran/Parser/Fortran90.y b/src/Language/Fortran/Parser/Fortran90.y --- a/src/Language/Fortran/Parser/Fortran90.y +++ b/src/Language/Fortran/Parser/Fortran90.y @@ -826,7 +826,7 @@ PARAMETER_ASSIGNMENT :: { Declarator A0 } : VARIABLE '=' EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 Nothing (Just $3) } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl Nothing (Just $3) } DECLARATION_STATEMENT :: { Statement A0 } : TYPE_SPEC ATTRIBUTE_LIST '::' INITIALIZED_DECLARATOR_LIST @@ -899,23 +899,23 @@ | DECLARATOR { $1 } DECLARATOR :: { Declarator A0 } -: VARIABLE { DeclVariable () (getSpan $1) $1 Nothing Nothing } +: VARIABLE + { Declarator () (getSpan $1) $1 ScalarDecl Nothing Nothing } | VARIABLE '*' EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 (Just $3) Nothing } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl (Just $3) Nothing } | VARIABLE '*' '(' '*' ')' { let star = ExpValue () (getSpan $4) ValStar - in DeclVariable () (getTransSpan $1 $5) $1 (Just star) Nothing } + in Declarator () (getTransSpan $1 $5) $1 ScalarDecl (Just star) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' - { DeclArray () (getTransSpan $1 $4) $1 (aReverse $3) Nothing Nothing } + { Declarator () (getTransSpan $1 $4) $1 (ArrayDecl (aReverse $3)) Nothing Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' EXPRESSION - { DeclArray () (getTransSpan $1 $6) $1 (aReverse $3) (Just $6) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $3)) (Just $6) Nothing } -- nonstandard char array syntax (wrong order for dimensions & charlen) | VARIABLE '*' EXPRESSION '(' DIMENSION_DECLARATORS ')' - { let star = ExpValue () (getSpan $4) ValStar - in DeclArray () (getTransSpan $1 $6) $1 (aReverse $5) (Just $3) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $5)) (Just $3) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' '(' '*' ')' { let star = ExpValue () (getSpan $7) ValStar - in DeclArray () (getTransSpan $1 $8) $1 (aReverse $3) (Just star) Nothing } + in Declarator () (getTransSpan $1 $8) $1 (ArrayDecl (aReverse $3)) (Just star) Nothing } DIMENSION_DECLARATORS :: { AList DimensionDeclarator A0 } : DIMENSION_DECLARATORS ',' DIMENSION_DECLARATOR diff --git a/src/Language/Fortran/Parser/Fortran95.y b/src/Language/Fortran/Parser/Fortran95.y --- a/src/Language/Fortran/Parser/Fortran95.y +++ b/src/Language/Fortran/Parser/Fortran95.y @@ -841,7 +841,7 @@ PARAMETER_ASSIGNMENT :: { Declarator A0 } : VARIABLE '=' EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 Nothing (Just $3) } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl Nothing (Just $3) } DECLARATION_STATEMENT :: { Statement A0 } : TYPE_SPEC ATTRIBUTE_LIST '::' INITIALIZED_DECLARATOR_LIST @@ -916,23 +916,23 @@ | DECLARATOR { $1 } DECLARATOR :: { Declarator A0 } -: VARIABLE { DeclVariable () (getSpan $1) $1 Nothing Nothing } +: VARIABLE + { Declarator () (getSpan $1) $1 ScalarDecl Nothing Nothing } | VARIABLE '*' EXPRESSION - { DeclVariable () (getTransSpan $1 $3) $1 (Just $3) Nothing } + { Declarator () (getTransSpan $1 $3) $1 ScalarDecl (Just $3) Nothing } | VARIABLE '*' '(' '*' ')' { let star = ExpValue () (getSpan $4) ValStar - in DeclVariable () (getTransSpan $1 $5) $1 (Just star) Nothing } + in Declarator () (getTransSpan $1 $5) $1 ScalarDecl (Just star) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' - { DeclArray () (getTransSpan $1 $4) $1 (aReverse $3) Nothing Nothing } + { Declarator () (getTransSpan $1 $4) $1 (ArrayDecl (aReverse $3)) Nothing Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' EXPRESSION - { DeclArray () (getTransSpan $1 $6) $1 (aReverse $3) (Just $6) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $3)) (Just $6) Nothing } -- nonstandard char array syntax (wrong order for dimensions & charlen) | VARIABLE '*' EXPRESSION '(' DIMENSION_DECLARATORS ')' - { let star = ExpValue () (getSpan $4) ValStar - in DeclArray () (getTransSpan $1 $6) $1 (aReverse $5) (Just $3) Nothing } + { Declarator () (getTransSpan $1 $6) $1 (ArrayDecl (aReverse $5)) (Just $3) Nothing } | VARIABLE '(' DIMENSION_DECLARATORS ')' '*' '(' '*' ')' { let star = ExpValue () (getSpan $7) ValStar - in DeclArray () (getTransSpan $1 $8) $1 (aReverse $3) (Just star) Nothing } + in Declarator () (getTransSpan $1 $8) $1 (ArrayDecl (aReverse $3)) (Just star) Nothing } DIMENSION_DECLARATORS :: { AList DimensionDeclarator A0 } : DIMENSION_DECLARATORS ',' DIMENSION_DECLARATOR diff --git a/src/Language/Fortran/PrettyPrint.hs b/src/Language/Fortran/PrettyPrint.hs --- a/src/Language/Fortran/PrettyPrint.hs +++ b/src/Language/Fortran/PrettyPrint.hs @@ -995,13 +995,13 @@ "end map" instance Pretty (Declarator a) where - pprint' v (DeclVariable _ _ e mLen mInit) + pprint' v (Declarator _ _ e ScalarDecl mLen mInit) | v >= Fortran90 = pprint' v e <> char '*' pprint' v mLen <+> char '=' pprint' v mInit - pprint' v (DeclVariable _ _ e mLen mInit) + pprint' v (Declarator _ _ e ScalarDecl mLen mInit) | v >= Fortran77 = case mInit of Nothing -> pprint' v e <> @@ -1010,19 +1010,19 @@ char '*' pprint' v mLen <> char '/' <> pprint' v initial <> char '/' - pprint' v (DeclVariable _ _ e mLen mInit) + pprint' v (Declarator _ _ e ScalarDecl mLen mInit) | Nothing <- mLen , Nothing <- mInit = pprint' v e | Just _ <- mInit = tooOld v "Variable initialisation" Fortran90 | Just _ <- mLen = tooOld v "Variable width" Fortran77 - pprint' v (DeclArray _ _ e dims mLen mInit) + pprint' v (Declarator _ _ e (ArrayDecl dims) mLen mInit) | v >= Fortran90 = pprint' v e <> parens (pprint' v dims) <+> "*" pprint' v mLen <+> equals pprint' v mInit - pprint' v (DeclArray _ _ e dims mLen mInit) + pprint' v (Declarator _ _ e (ArrayDecl dims) mLen mInit) | v >= Fortran77 = case mInit of Nothing -> pprint' v e <> parens (pprint' v dims) <> @@ -1035,7 +1035,7 @@ in pprint' v e <> parens (pprint' v dims) <> "*" pprint' v mLen <> initDoc - pprint' v (DeclArray _ _ e dims mLen mInit) + pprint' v (Declarator _ _ e (ArrayDecl dims) mLen mInit) | Nothing <- mLen , Nothing <- mInit = pprint' v e <> parens (pprint' v dims) | Just _ <- mInit = tooOld v "Variable initialisation" Fortran90 diff --git a/src/Language/Fortran/Util/ModFile.hs b/src/Language/Fortran/Util/ModFile.hs --- a/src/Language/Fortran/Util/ModFile.hs +++ b/src/Language/Fortran/Util/ModFile.hs @@ -250,8 +250,7 @@ -- Extract variable name and source span from declaration declVarName :: F.Declarator (FA.Analysis a) -> (F.Name, P.SrcSpan) - declVarName (F.DeclVariable _ _ e _ _) = (FA.varName e, P.getSpan e) - declVarName (F.DeclArray _ _ e _ _ _) = (FA.varName e, P.getSpan e) + declVarName (F.Declarator _ _ e _ _ _) = (FA.varName e, P.getSpan e) -- Extract context identifier, a function return value (+ source -- span) if present, and a list of contained blocks @@ -298,12 +297,12 @@ | F.PUModule _ _ _ bs _ <- universeBi pf' :: [F.ProgramUnit (FA.Analysis a)] , st@(F.StDeclaration _ _ (F.TypeSpec _ _ _ _) _ _) <- universeBi bs :: [F.Statement (FA.Analysis a)] , F.AttrParameter _ _ <- universeBi st :: [F.Attribute (FA.Analysis a)] - , (F.DeclVariable _ _ v _ _) <- universeBi st :: [F.Declarator (FA.Analysis a)] + , (F.Declarator _ _ v F.ScalarDecl _ _) <- universeBi st :: [F.Declarator (FA.Analysis a)] , Just con <- [FA.constExp (F.getAnnotation v)] ] ++ [ (FA.varName v, con) | F.PUModule _ _ _ bs _ <- universeBi pf' :: [F.ProgramUnit (FA.Analysis a)] , st@F.StParameter {} <- universeBi bs :: [F.Statement (FA.Analysis a)] - , (F.DeclVariable _ _ v _ _) <- universeBi st :: [F.Declarator (FA.Analysis a)] + , (F.Declarator _ _ v F.ScalarDecl _ _) <- universeBi st :: [F.Declarator (FA.Analysis a)] , Just con <- [FA.constExp (F.getAnnotation v)] ] -- | Status of mod-file compared to Fortran file. diff --git a/test/Language/Fortran/AST/BozSpec.hs b/test/Language/Fortran/AST/BozSpec.hs --- a/test/Language/Fortran/AST/BozSpec.hs +++ b/test/Language/Fortran/AST/BozSpec.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE TypeApplications #-} + module Language.Fortran.AST.BozSpec where import Test.Hspec import Language.Fortran.AST.Boz +import Numeric.Natural ( Natural ) spec :: Spec spec = do @@ -12,3 +15,6 @@ it "parses nonstandard X as Z (hex)" $ do parseBoz "x'09af'" `shouldBe` parseBoz "z'09af'" + + it "resolves a BOZ as a natural" $ do + bozAsNatural @Natural (parseBoz "x'FF'") `shouldBe` 255 diff --git a/test/Language/Fortran/Analysis/RenamingSpec.hs b/test/Language/Fortran/Analysis/RenamingSpec.hs --- a/test/Language/Fortran/Analysis/RenamingSpec.hs +++ b/test/Language/Fortran/Analysis/RenamingSpec.hs @@ -155,12 +155,12 @@ ex2pu1bs :: [Block ()] ex2pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclArray () u (varGen "b") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing - , DeclVariable () u (varGen "c") Nothing Nothing - , DeclVariable () u (varGen "d") Nothing Nothing ])) + [ declVarGen "a" + , Declarator () u (varGen "b") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing + , declVarGen "c" + , declVarGen "d" ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "a") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "a") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing ])) , BlStatement () u Nothing (StExpressionAssign () u (ExpSubscript () u (varGen "a") (AList () u [ ixSinGen 1 ])) (intGen 1)) , BlStatement () u Nothing (StExpressionAssign () u @@ -177,14 +177,14 @@ ex3pu1bs :: [Block ()] ex3pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclArray () u (varGen "b") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing - , DeclVariable () u (varGen "c") Nothing Nothing - , DeclVariable () u (varGen "d") Nothing Nothing ])) + [ declVarGen "a" + , Declarator () u (varGen "b") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing + , declVarGen "c" + , declVarGen "d" ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "a") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "a") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing ])) , BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "c") Nothing Nothing ])) + [ declVarGen "c" ])) , BlStatement () u Nothing (StExpressionAssign () u (ExpSubscript () u (varGen "a") (AList () u [ ixSinGen 1 ])) (intGen 1)) , BlStatement () u Nothing (StExpressionAssign () u @@ -203,8 +203,8 @@ ex4pu1bs :: [Block ()] ex4pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "f1") Nothing Nothing - , DeclVariable () u (varGen "r") Nothing Nothing ])) + [ declVarGen "f1" + , declVarGen "r" ])) , BlStatement () u Nothing (StExpressionAssign () u (ExpValue () u (ValVariable "r")) (ExpFunctionCall () u (ExpValue () u (ValVariable "f1")) diff --git a/test/Language/Fortran/Analysis/TypesSpec.hs b/test/Language/Fortran/Analysis/TypesSpec.hs --- a/test/Language/Fortran/Analysis/TypesSpec.hs +++ b/test/Language/Fortran/Analysis/TypesSpec.hs @@ -235,13 +235,13 @@ ex4pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing - , DeclArray () u (varGen "y") - (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 10) ]) Nothing Nothing ])) + [ declVarGen "x" + , Declarator () u (varGen "y") + (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 10) ])) Nothing Nothing ])) , BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeCharacter Nothing) Nothing - (AList () u [ DeclVariable () u (varGen "c") Nothing Nothing ])) + (AList () u [ declVarGen "c" ])) , BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeLogical Nothing) Nothing - (AList () u [ DeclVariable () u (varGen "log") Nothing Nothing ])) ] + (AList () u [ declVarGen "log" ])) ] ex5 :: ProgramFile () ex5 = ProgramFile mi77 [ ex5pu1 ] @@ -250,8 +250,8 @@ ex5pu1bs :: [Block ()] ex5pu1bs = [ BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "x") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing - , DeclArray () u (varGen "y") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing])) ] + [ declArray () u (varGen "x") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing + , declArray () u (varGen "y") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing])) ] {- - program Main @@ -270,11 +270,11 @@ ex6pu1bs :: [Block ()] ex6pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclArray () u (varGen "b") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing - , DeclVariable () u (varGen "c") Nothing Nothing ])) + [ declVarGen "a" + , Declarator () u (varGen "b") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing + , declVarGen "c" ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "a") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "a") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1 ) ])) Nothing Nothing ])) , BlStatement () u Nothing (StExpressionAssign () u (ExpSubscript () u (varGen "a") (fromList () [ ixSinGen 1 ])) (intGen 1)) , BlStatement () u Nothing (StExpressionAssign () u diff --git a/test/Language/Fortran/Parser/Fortran2003Spec.hs b/test/Language/Fortran/Parser/Fortran2003Spec.hs --- a/test/Language/Fortran/Parser/Fortran2003Spec.hs +++ b/test/Language/Fortran/Parser/Fortran2003Spec.hs @@ -43,34 +43,34 @@ let renames = fromList () [ UseRename () u (varGen "sprod") (varGen "prod") , UseRename () u (varGen "a") (varGen "b") ] - let st = StUse () u (varGen "mod") (Just ModIntrinsic) Permissive (Just renames) + st = StUse () u (varGen "mod") (Just ModIntrinsic) Permissive (Just renames) sParser "use, intrinsic :: mod, sprod => prod, a => b" `shouldBe'` st it "parses use statement, non_intrinsic module" $ do let renames = fromList () [ UseRename () u (varGen "sprod") (varGen "prod") , UseRename () u (varGen "a") (varGen "b") ] - let st = StUse () u (varGen "mod") (Just ModNonIntrinsic) Exclusive (Just renames) + st = StUse () u (varGen "mod") (Just ModNonIntrinsic) Exclusive (Just renames) sParser "use, non_intrinsic :: mod, only: sprod => prod, a => b" `shouldBe'` st it "parses use statement, unspecified nature of module" $ do let renames = fromList () [ UseRename () u (varGen "sprod") (varGen "prod") , UseRename () u (varGen "a") (varGen "b") ] - let st = StUse () u (varGen "mod") Nothing Permissive (Just renames) + st = StUse () u (varGen "mod") Nothing Permissive (Just renames) sParser "use :: mod, sprod => prod, a => b" `shouldBe'` st it "parses procedure (interface-name, attribute, proc-decl)" $ do let call = ExpFunctionCall () u (varGen "c") Nothing - let st = StProcedure () u (Just (ProcInterfaceName () u (varGen "a"))) + st = StProcedure () u (Just (ProcInterfaceName () u (varGen "a"))) (Just (AttrSave () u)) (AList () u [ProcDecl () u (varGen "b") (Just call)]) sParser "PROCEDURE(a), SAVE :: b => c()" `shouldBe'` st it "parses procedure (class-star, bind-name, proc-decls)" $ do let call = ExpFunctionCall () u (varGen "c") Nothing - let clas = TypeSpec () u ClassStar Nothing - let st = StProcedure () u (Just (ProcInterfaceType () u clas)) + clas = TypeSpec () u ClassStar Nothing + st = StProcedure () u (Just (ProcInterfaceType () u clas)) (Just (AttrSuffix () u (SfxBind () u (Just (ExpValue () u (ValString "e")))))) (AList () u [ProcDecl () u (varGen "b") (Just call) ,ProcDecl () u (varGen "d") (Just call)]) @@ -78,8 +78,8 @@ it "parses procedure (class-custom, bind, proc-decls)" $ do let call = ExpFunctionCall () u (varGen "c") Nothing - let clas = TypeSpec () u (ClassCustom "e") Nothing - let st = StProcedure () u (Just (ProcInterfaceType () u clas)) + clas = TypeSpec () u (ClassCustom "e") Nothing + st = StProcedure () u (Just (ProcInterfaceType () u clas)) (Just (AttrSuffix () u (SfxBind () u Nothing))) (AList () u [ProcDecl () u (varGen "b") (Just call) ,ProcDecl () u (varGen "d") (Just call)]) @@ -106,44 +106,44 @@ fParser fStr `shouldBe'` expected it "parses asynchronous decl" $ do - let decls = [DeclVariable () u (varGen "a") Nothing Nothing, DeclVariable () u (varGen "b") Nothing Nothing] - let st = StAsynchronous () u (AList () u decls) + let decls = [declVarGen "a", declVarGen "b"] + st = StAsynchronous () u (AList () u decls) sParser "asynchronous a, b" `shouldBe'` st sParser "asynchronous :: a, b" `shouldBe'` st it "parses asynchronous attribute" $ do - let decls = [DeclVariable () u (varGen "a") Nothing Nothing, DeclVariable () u (varGen "b") Nothing Nothing] - let ty = TypeSpec () u TypeInteger Nothing - let attrs = [AttrAsynchronous () u] - let st = StDeclaration () u ty (Just (AList () u attrs)) (AList () u decls) + let decls = [declVarGen "a", declVarGen "b"] + ty = TypeSpec () u TypeInteger Nothing + attrs = [AttrAsynchronous () u] + st = StDeclaration () u ty (Just (AList () u attrs)) (AList () u decls) sParser "integer, asynchronous :: a, b" `shouldBe'` st it "parses enumerators" $ do - let decls = [ DeclVariable () u (varGen "a") Nothing (Just (intGen 1)) - , DeclVariable () u (varGen "b") Nothing Nothing ] - let st = StEnumerator () u (AList () u decls) + let decls = [ declVariable () u (varGen "a") Nothing (Just (intGen 1)) + , declVariable () u (varGen "b") Nothing Nothing ] + st = StEnumerator () u (AList () u decls) sParser "enum, bind(c)" `shouldBe'` StEnum () u sParser "enumerator :: a = 1, b" `shouldBe'` st sParser "end enum" `shouldBe'` StEndEnum () u it "parses allocate with type_spec" $ do let sel = Selector () u (Just (ExpValue () u ValColon)) (Just (varGen "foo")) - let ty = TypeSpec () u TypeCharacter (Just sel) - let decls = [DeclVariable () u (varGen "s") Nothing Nothing] - let st = StDeclaration () u ty (Just (AList () u [AttrAllocatable () u])) (AList () u decls) + ty = TypeSpec () u TypeCharacter (Just sel) + decls = AList () u [declVarGen "s"] + st = StDeclaration () u ty (Just (AList () u [AttrAllocatable () u])) decls sParser "character(len=:,kind=foo), allocatable :: s" `shouldBe'` st it "parses allocate with type_spec" $ do let sel = Selector () u (Just (intGen 3)) (Just (varGen "foo")) - let ty = TypeSpec () u TypeCharacter (Just sel) - let st = StAllocate () u (Just ty) (AList () u [varGen "s"]) Nothing + ty = TypeSpec () u TypeCharacter (Just sel) + st = StAllocate () u (Just ty) (AList () u [varGen "s"]) Nothing sParser "allocate(character(len=3,kind=foo) :: s)" `shouldBe'` st it "parses protected" $ do let ty = TypeSpec () u TypeReal Nothing - let decls = AList () u [DeclVariable () u (varGen "x") Nothing Nothing] - let st1 = StDeclaration () u ty (Just (AList () u [AttrProtected () u, AttrPublic () u])) decls - let st2 = StProtected () u (Just (AList () u [varGen "x"])) + decls = AList () u [declVarGen "x"] + st1 = StDeclaration () u ty (Just (AList () u [AttrProtected () u, AttrPublic () u])) decls + st2 = StProtected () u (Just (AList () u [varGen "x"])) sParser "real, protected, public :: x" `shouldBe'` st1 sParser "protected x" `shouldBe'` st2 diff --git a/test/Language/Fortran/Parser/Fortran66Spec.hs b/test/Language/Fortran/Parser/Fortran66Spec.hs --- a/test/Language/Fortran/Parser/Fortran66Spec.hs +++ b/test/Language/Fortran/Parser/Fortran66Spec.hs @@ -136,9 +136,9 @@ it "parses 'integer i, j(2,2), k'" $ do let dimDecls = replicate 2 $ DimensionDeclarator () u Nothing (Just $ intGen 2) - declarators = [ DeclVariable () u (varGen "i") Nothing Nothing - , DeclArray () u (varGen "j") (AList () u dimDecls) Nothing Nothing - , DeclVariable () u (varGen "k") Nothing Nothing ] + declarators = [ Declarator () u (varGen "i") ScalarDecl Nothing Nothing + , Declarator () u (varGen "j") (ArrayDecl (AList () u dimDecls)) Nothing Nothing + , Declarator () u (varGen "k") ScalarDecl Nothing Nothing ] st = StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing $ AList () u declarators sParser " integer i, j(2,2), k" `shouldBe'` st diff --git a/test/Language/Fortran/Parser/Fortran77/IncludeSpec.hs b/test/Language/Fortran/Parser/Fortran77/IncludeSpec.hs --- a/test/Language/Fortran/Parser/Fortran77/IncludeSpec.hs +++ b/test/Language/Fortran/Parser/Fortran77/IncludeSpec.hs @@ -42,7 +42,7 @@ pu = PUMain () puSpan (Just name) blocks Nothing blocks = [bl1] - decl = DeclVariable () blockSpan (varGen' "a") Nothing Nothing + decl = Declarator () blockSpan (varGen' "a") ScalarDecl Nothing Nothing typeSpec = TypeSpec () typeSpan TypeInteger Nothing st2 = StDeclaration () st2Span typeSpec Nothing (AList () blockSpan [decl]) bl1 = BlStatement () st1Span Nothing st1 diff --git a/test/Language/Fortran/Parser/Fortran77/ParserSpec.hs b/test/Language/Fortran/Parser/Fortran77/ParserSpec.hs --- a/test/Language/Fortran/Parser/Fortran77/ParserSpec.hs +++ b/test/Language/Fortran/Parser/Fortran77/ParserSpec.hs @@ -73,14 +73,14 @@ eParser "(x, y(i), i = 1, 10, 2)" `shouldBe'` impliedDo it "parses main program unit" $ do - let decl = DeclVariable () u (varGen "x") Nothing Nothing + let decl = declVarGen "x" st = StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u [ decl ]) bl = BlStatement () u Nothing st pu = ProgramFile mi77 [ PUMain () u (Just "hello") [ bl ] Nothing ] pParser exampleProgram1 `shouldBe'` pu it "parses block data unit" $ do - let decl = DeclVariable () u (varGen "x") Nothing Nothing + let decl = declVarGen "x" st = StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u [ decl ]) bl = BlStatement () u Nothing st pu = ProgramFile mi77 [ PUBlockData () u (Just "hello") [ bl ] ] @@ -115,7 +115,7 @@ let dimDecls = [ DimensionDeclarator () u (Just $ intGen 1) (Just $ intGen 2) , DimensionDeclarator () u Nothing (Just $ intGen 15) , DimensionDeclarator () u (Just $ varGen "x") (Just starVal) ] - decl = DeclArray () u (varGen "a") (AList () u dimDecls) Nothing Nothing + decl = declArray () u (varGen "a") (AList () u dimDecls) Nothing Nothing st = StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u [ decl ]) sParser " integer a(1:2, 15, x:*)" `shouldBe'` st @@ -167,10 +167,10 @@ sParser " implicit character*30 (a, b, c), integer (a-z, l)" `shouldBe'` st it "parses 'parameter (pi = 3.14, b = 'X' // 'O', d = k) '" $ do - let sts = [ DeclVariable () u (varGen "pi") Nothing (Just $ realGen (3.14::Double)) + let sts = [ declVariable () u (varGen "pi") Nothing (Just $ realGen (3.14::Double)) , let e = ExpBinary () u Concatenation (strGen "X") (strGen "O") - in DeclVariable () u (varGen "b") Nothing (Just e) - , DeclVariable () u (varGen "d") Nothing (Just $ varGen "k") ] + in declVariable () u (varGen "b") Nothing (Just e) + , declVariable () u (varGen "d") Nothing (Just $ varGen "k") ] st = StParameter () u (AList () u sts) sParser " parameter (pi = 3.14, b = 'X' // 'O', d = k)" `shouldBe'` st @@ -200,7 +200,7 @@ sParser " entry me (a,b,*)" `shouldBe'` st it "parses 'character a*8'" $ do - let decl = DeclVariable () u (varGen "a") (Just $ intGen 8) Nothing + let decl = declVariable () u (varGen "a") (Just $ intGen 8) Nothing typeSpec = TypeSpec () u TypeCharacter Nothing st = StDeclaration () u typeSpec Nothing (AList () u [ decl ]) sParser " character a*8" `shouldBe'` st @@ -208,13 +208,13 @@ it "parses 'character c*(ichar('A'))" $ do let args = AList () u [ IxSingle () u Nothing (ExpValue () u (ValString "A")) ] lenExpr = ExpSubscript () u (varGen "ichar") args - decl = DeclVariable () u (varGen "c") (Just $ lenExpr) Nothing + decl = declVariable () u (varGen "c") (Just $ lenExpr) Nothing typeSpec = TypeSpec () u TypeCharacter Nothing st = StDeclaration () u typeSpec Nothing (AList () u [ decl ]) sParser " character c*(ichar('A'))" `shouldBe'` st it "parses included files" $ do - let decl = DeclVariable () u (varGen "a") Nothing Nothing + let decl = declVariable () u (varGen "a") Nothing Nothing typeSpec = TypeSpec () u TypeInteger Nothing st = StDeclaration () u typeSpec Nothing (AList () u [ decl ]) bl = BlStatement () u Nothing st @@ -259,10 +259,10 @@ , " end structure"] ds = [ UnionMap () u $ AList () u [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing $ - AList () u [DeclVariable () u (varGen "i") Nothing Nothing]] + AList () u [declVariable () u (varGen "i") Nothing Nothing]] , UnionMap () u $ AList () u [StructFields () u (TypeSpec () u TypeReal Nothing) Nothing $ - AList () u [DeclVariable () u (varGen "r") Nothing Nothing]] + AList () u [declVariable () u (varGen "r") Nothing Nothing]] ] st = StStructure () u (Just "foo") $ AList () u [StructUnion () u $ AList () u ds] resetSrcSpan (slParser src) `shouldBe` st @@ -287,10 +287,10 @@ , " end structure"] ds = [ UnionMap () u $ AList () u [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing $ - AList () u [DeclVariable () u (varGen "i") Nothing Nothing]] + AList () u [declVariable () u (varGen "i") Nothing Nothing]] , UnionMap () u $ AList () u [StructFields () u (TypeSpec () u TypeReal Nothing) Nothing $ - AList () u [DeclVariable () u (varGen "r") Nothing Nothing]] + AList () u [declVariable () u (varGen "r") Nothing Nothing]] ] st = StStructure () u (Just "foo") $ AList () u [StructUnion () u $ AList () u ds] resetSrcSpan (slParser src) `shouldBe` st @@ -302,7 +302,7 @@ , " integer qux" , " end structure" , " end structure"] - var = DeclVariable () u (varGen "qux") Nothing Nothing + var = declVariable () u (varGen "qux") Nothing Nothing innerst = StructStructure () u (Just "bar") ("baz") $ AList () u [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing $ AList () u [var]] @@ -331,7 +331,7 @@ it "parses character declarations with unspecfied lengths" $ do let src = " character s*(*)" st = StDeclaration () u (TypeSpec () u TypeCharacter Nothing) Nothing $ - AList () u [DeclVariable () u + AList () u [declVariable () u (varGen "s") (Just (ExpValue () u ValStar)) Nothing] @@ -341,7 +341,7 @@ let src = " integer xs(3) / 1, 2, 3 /" inits = [intGen 1, intGen 2, intGen 3] st = StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing $ - AList () u [DeclArray () u + AList () u [declArray () u (varGen "xs") (AList () u [DimensionDeclarator () u Nothing (Just (intGen 3))]) Nothing @@ -351,7 +351,7 @@ let src1 = " character xs(2)*5 / 'hello', 'world' /" inits1 = [ExpValue () u (ValString "hello"), ExpValue () u (ValString "world")] st1 = StDeclaration () u (TypeSpec () u TypeCharacter Nothing) Nothing $ - AList () u [DeclArray () u + AList () u [declArray () u (varGen "xs") (AList () u [DimensionDeclarator () u Nothing (Just (intGen 2))]) (Just (intGen 5)) @@ -361,7 +361,7 @@ let src2 = " character xs*5(2) / 'hello', 'world' /" inits2 = [ExpValue () u (ValString "hello"), ExpValue () u (ValString "world")] st2 = StDeclaration () u (TypeSpec () u TypeCharacter Nothing) Nothing $ - AList () u [DeclArray () u + AList () u [declArray () u (varGen "xs") (AList () u [DimensionDeclarator () u Nothing (Just (intGen 2))]) (Just (intGen 5)) @@ -391,7 +391,7 @@ st3 = StExpressionAssign () u tgt3 (intGen 0) resetSrcSpan (slParser src3) `shouldBe` st3 it "parses automatic and static statements" $ do - let decl = DeclVariable () u (varGen "x") Nothing Nothing + let decl = declVariable () u (varGen "x") Nothing Nothing autoStmt = StAutomatic () u (AList () u [decl]) staticStmt = StStatic () u (AList () u [decl]) autoSrc = " automatic x" diff --git a/test/Language/Fortran/Parser/Fortran90Spec.hs b/test/Language/Fortran/Parser/Fortran90Spec.hs --- a/test/Language/Fortran/Parser/Fortran90Spec.hs +++ b/test/Language/Fortran/Parser/Fortran90Spec.hs @@ -53,7 +53,7 @@ describe "Fortran 90 Parser" $ do describe "Function" $ do let puFunction = PUFunction () u - let fType = Nothing + fType = Nothing fPre = emptyPrefixes fPreR = Just $ AList () u [PfxRecursive () u] fSuf = emptySuffixes @@ -67,27 +67,27 @@ describe "End" $ do it "parses simple functions ending with \"end function [function name]\"" $ do let expected = puFunction fType fPreSuf fName fArgs fRes fBody fSub - let fStr = init $ unlines ["function f()" + fStr = init $ unlines ["function f()" , "end function f" ] fParser fStr `shouldBe'` expected it "parses simple functions ending with \"end\"" $ do let expected = puFunction fType fPreSuf fName fArgs fRes fBody fSub - let fStr = init $ unlines ["function f()" + fStr = init $ unlines ["function f()" , "end" ] fParser fStr `shouldBe'` expected it "parses simple functions ending with \"end function\"" $ do let expected = puFunction fType fPreSuf fName fArgs fRes fBody fSub - let fStr = init $ unlines ["function f()" + fStr = init $ unlines ["function f()" , "end function" ] fParser fStr `shouldBe'` expected it "parses functions with return type specs" $ do let fType' = Just $ TypeSpec () u TypeInteger Nothing - let expected = puFunction fType' fPreSuf fName fArgs fRes fBody fSub - let fStr = init $ unlines ["integer function f()" + expected = puFunction fType' fPreSuf fName fArgs fRes fBody fSub + fStr = init $ unlines ["integer function f()" , "end function f" ] fParser fStr `shouldBe'` expected @@ -152,7 +152,7 @@ describe "Custom operator" $ do let unOp = UnCustom ".inverse." - let unExp = ExpUnary () u unOp $ intGen 42 + unExp = ExpUnary () u unOp $ intGen 42 it "parses unary custom operator" $ eParser ".inverse. 42" `shouldBe'` unExp @@ -168,100 +168,94 @@ it "parses data ref" $ do let range = fromList () [ IxSingle () u Nothing $ intGen 10 ] - let sub = ExpSubscript () u (varGen "y") range - let innerRefExp = ExpDataRef () u (varGen "x") sub - let exp = ExpDataRef () u innerRefExp (varGen "z") + sub = ExpSubscript () u (varGen "y") range + innerRefExp = ExpDataRef () u (varGen "x") sub + exp = ExpDataRef () u innerRefExp (varGen "z") eParser "x % y(10) % z" `shouldBe'` exp it "parses section subscript" $ do let range = [ IxSingle () u Nothing $ intGen 10 , IxRange () u Nothing (Just $ intGen 1) (Just $ intGen 2) , IxSingle () u Nothing $ varGen "y" ] - let exp = ExpSubscript () u (varGen "x") (fromList () range) + exp = ExpSubscript () u (varGen "x") (fromList () range) eParser "x (10, : 1 : 2, y)" `shouldBe'` exp describe "Statement" $ do it "data ref assignment" $ do let indicies = AList () u [ IxSingle () u Nothing (intGen 1) ] - let subs = ExpSubscript () u (varGen "x") indicies - let lhs = ExpDataRef () u subs (varGen "y") - let st = StExpressionAssign () u lhs (intGen 1) + subs = ExpSubscript () u (varGen "x") indicies + lhs = ExpDataRef () u subs (varGen "y") + st = StExpressionAssign () u lhs (intGen 1) sParser "x(1) % y = 1" `shouldBe'` st it "parses pause statements" $ do let stPause = StPause () u Nothing - let stStr = "PAUSE" + stStr = "PAUSE" sParser stStr `shouldBe'` stPause it "parses pause statements with expression" $ do let stPause = StPause () u (Just (strGen "MESSAGE")) - let stStr = "PAUSE \"MESSAGE\"" + stStr = "PAUSE \"MESSAGE\"" sParser stStr `shouldBe'` stPause it "parses declaration with attributes" $ do let typeSpec = TypeSpec () u TypeReal Nothing - let attrs = AList () u [ AttrExternal () u + attrs = AList () u [ AttrExternal () u , AttrIntent () u Out , AttrDimension () u $ AList () u [ DimensionDeclarator () u (Just $ intGen 3) (Just $ intGen 10) ] ] - let declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing - , DeclVariable () u (varGen "y") Nothing Nothing ] - let expected = StDeclaration () u typeSpec (Just attrs) declarators - let stStr = "real, external, intent (out), dimension (3:10) :: x, y" + declarators = AList () u [ declVarGen "x", declVarGen "y"] + expected = StDeclaration () u typeSpec (Just attrs) declarators + stStr = "real, external, intent (out), dimension (3:10) :: x, y" sParser stStr `shouldBe'` expected it "parses declaration with old syntax" $ do let typeSpec = TypeSpec () u TypeLogical Nothing - let declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing - , DeclVariable () u (varGen "y") Nothing Nothing ] - let expected = StDeclaration () u typeSpec Nothing declarators - let stStr = "logical x, y" + declarators = AList () u [ declVarGen "x", declVarGen "y"] + expected = StDeclaration () u typeSpec Nothing declarators + stStr = "logical x, y" sParser stStr `shouldBe'` expected it "parses declaration with initialisation" $ let typeSpec = TypeSpec () u TypeComplex Nothing init' = ExpValue () u (ValComplex (intGen 24) (realGen (42.0::Double))) declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing (Just init') ] + [ declVariable () u (varGen "x") Nothing (Just init') ] expected = StDeclaration () u typeSpec Nothing declarators stStr = "complex :: x = (24, 42.0)" in sParser stStr `shouldBe'` expected it "parses declaration of custom type" $ do let typeSpec = TypeSpec () u (TypeCustom "meinetype") Nothing - let declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing ] - let expected = StDeclaration () u typeSpec Nothing declarators - let stStr = "type (MeineType) :: x" + declarators = AList () u [declVarGen "x"] + expected = StDeclaration () u typeSpec Nothing declarators + stStr = "type (MeineType) :: x" sParser stStr `shouldBe'` expected it "parses declaration type with kind selector" $ do let selector = Selector () u Nothing (Just $ varGen "hello") - let typeSpec = TypeSpec () u TypeInteger (Just selector) - let declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing ] - let expected = StDeclaration () u typeSpec Nothing declarators - let stStr = "integer (hello) :: x" + typeSpec = TypeSpec () u TypeInteger (Just selector) + declarators = AList () u [declVarGen "x"] + expected = StDeclaration () u typeSpec Nothing declarators + stStr = "integer (hello) :: x" sParser stStr `shouldBe'` expected it "parses intent statement" $ do let stStr = "intent (inout) :: a" - let expected = StIntent () u InOut (fromList () [ varGen "a" ]) + expected = StIntent () u InOut (fromList () [ varGen "a" ]) sParser stStr `shouldBe'` expected it "parses optional statement" $ do let stStr = "optional x" - let expected = StOptional () u (fromList () [ varGen "x" ]) + expected = StOptional () u (fromList () [ varGen "x" ]) sParser stStr `shouldBe'` expected it "parses public statement" $ do let stStr = "public :: x" - let expected = StPublic () u (Just $ fromList () [ varGen "x" ]) + expected = StPublic () u (Just $ fromList () [ varGen "x" ]) sParser stStr `shouldBe'` expected it "parses public assignment" $ do @@ -277,14 +271,14 @@ it "parses save statement" $ do let list = [ varGen "hello", varGen "bye" ] - let expected = StSave () u (Just $ fromList () list) - let stStr = "save /hello/, bye" + expected = StSave () u (Just $ fromList () list) + stStr = "save /hello/, bye" sParser stStr `shouldBe'` expected it "parses parameter statement" $ do - let ass1 = DeclVariable () u (varGen "x") Nothing (Just $ intGen 10) - let ass2 = DeclVariable () u (varGen "y") Nothing (Just $ intGen 20) - let expected = StParameter () u (fromList () [ ass1, ass2 ]) + let ass1 = declVariable () u (varGen "x") Nothing (Just $ intGen 10) + ass2 = declVariable () u (varGen "y") Nothing (Just $ intGen 20) + expected = StParameter () u (fromList () [ ass1, ass2 ]) sParser "parameter (x = 10, y = 20)" `shouldBe'` expected describe "Implicit" $ do @@ -294,45 +288,45 @@ it "parses implicit with single" $ do let typeSpec = TypeSpec () u TypeCharacter Nothing - let impEls = [ ImpCharacter () u "k" ] - let impLists = [ ImpList () u typeSpec (fromList () impEls) ] - let st = StImplicit () u (Just $ fromList () impLists) + impEls = [ ImpCharacter () u "k" ] + impLists = [ ImpList () u typeSpec (fromList () impEls) ] + st = StImplicit () u (Just $ fromList () impLists) sParser "implicit character (k)" `shouldBe'` st it "parses implicit with range" $ do let typeSpec = TypeSpec () u TypeLogical Nothing - let impEls = [ ImpRange () u "x" "z" ] - let impLists = [ ImpList () u typeSpec (fromList () impEls) ] - let st = StImplicit () u (Just $ fromList () impLists) + impEls = [ ImpRange () u "x" "z" ] + impLists = [ ImpList () u typeSpec (fromList () impEls) ] + st = StImplicit () u (Just $ fromList () impLists) sParser "implicit logical (x-z)" `shouldBe'` st it "parses implicit statement" $ do let typeSpec1 = TypeSpec () u TypeCharacter Nothing - let typeSpec2 = TypeSpec () u TypeInteger Nothing - let impEls1 = [ ImpCharacter () u "s", ImpCharacter () u "a" ] - let impEls2 = [ ImpRange () u "x" "z" ] - let impLists = [ ImpList () u typeSpec1 (fromList () impEls1) + typeSpec2 = TypeSpec () u TypeInteger Nothing + impEls1 = [ ImpCharacter () u "s", ImpCharacter () u "a" ] + impEls2 = [ ImpRange () u "x" "z" ] + impLists = [ ImpList () u typeSpec1 (fromList () impEls1) , ImpList () u typeSpec2 (fromList () impEls2) ] - let st = StImplicit () u (Just $ fromList () impLists) + st = StImplicit () u (Just $ fromList () impLists) sParser "implicit character (s, a), integer (x-z)" `shouldBe'` st describe "Data" $ do it "parses vanilla" $ do let nlist = fromList () [ varGen "x", varGen "y" ] - let vlist = fromList () [ intGen 1, intGen 2 ] - let list = [ DataGroup () u nlist vlist ] - let expected = StData () u (fromList () list) - let stStr = "data x,y/1,2/" + vlist = fromList () [ intGen 1, intGen 2 ] + list = [ DataGroup () u nlist vlist ] + expected = StData () u (fromList () list) + stStr = "data x,y/1,2/" sParser stStr `shouldBe'` expected describe "Delimeter" $ do let [ nlist1, vlist1 ] = map (fromList () . return) [ varGen "x", intGen 1 ] - let [ nlist2, vlist2 ] = + [ nlist2, vlist2 ] = map (fromList () . return) [ varGen "y", intGen 2 ] - let list = [ DataGroup () u nlist1 vlist1 + list = [ DataGroup () u nlist1 vlist1 , DataGroup () u nlist2 vlist2 ] - let expected = StData () u (fromList () list) + expected = StData () u (fromList () list) it "parses comma delimited init groups" $ sParser "data x/1/, y/2/" `shouldBe'` expected @@ -343,9 +337,9 @@ describe "Namelist" $ do let groupNames = [ ExpValue () u (ValVariable "something") , ExpValue () u (ValVariable "other") ] - let itemss = [ fromList () [ varGen "a", varGen "b", varGen "c" ] + itemss = [ fromList () [ varGen "a", varGen "b", varGen "c" ] , fromList () [ varGen "y" ] ] - let st = StNamelist () u $ + st = StNamelist () u $ fromList () [ Namelist () u (head groupNames) (head itemss) , Namelist () u (last groupNames) (last itemss) ] @@ -358,9 +352,9 @@ describe "Common" $ do let commonNames = [ ExpValue () u (ValVariable "something") , ExpValue () u (ValVariable "other") ] - let itemss = [ fromList () [ declVarGen "a", declVarGen "b", declVarGen "c" ] + itemss = [ fromList () [ declVarGen "a", declVarGen "b", declVarGen "c" ] , fromList () [ declVarGen "y" ] ] - let st = StCommon () u $ fromList () + st = StCommon () u $ fromList () [ CommonGroup () u Nothing (fromList () [ declVarGen "q" ]) , CommonGroup () u (Just $ head commonNames) (head itemss) , CommonGroup () u (Just $ last commonNames) (last itemss) ] @@ -393,7 +387,7 @@ describe "Dynamic allocation" $ do it "parses allocate statement" $ do let opt = AOStat () u (varGen "a") - let allocs = fromList () + allocs = fromList () [ varGen "x" , ExpDataRef () u (varGen "st") (varGen "part") ] @@ -402,12 +396,12 @@ it "parses deallocate statement" $ do let opt = AOStat () u (varGen "a") - let allocs = fromList () + allocs = fromList () [ let indicies = fromList () [ IxSingle () u Nothing (intGen 20) ] in ExpSubscript () u (varGen "smt") indicies ] - let s = StDeallocate () u allocs Nothing - let s' = StDeallocate () u allocs (Just (AList () u [opt])) + s = StDeallocate () u allocs Nothing + s' = StDeallocate () u allocs (Just (AList () u [opt])) sParser "deallocate (smt ( 20 ))" `shouldBe'` s sParser "deallocate (smt ( 20 ), stat=a)" `shouldBe'` s' @@ -417,15 +411,15 @@ it "parses pointer assignment" $ do let src = ExpDataRef () u (varGen "x") (varGen "y") - let st = StPointerAssign () u src (varGen "exp") + st = StPointerAssign () u src (varGen "exp") sParser "x % y => exp" `shouldBe'` st describe "Where" $ do it "parses where statement" $ do let exp = ExpBinary () u Subtraction (varGen "temp") (varGen "r_temp") - let pred = ExpBinary () u GT (varGen "temp") (intGen 100) - let assignment = StExpressionAssign () u (varGen "temp") exp - let st = StWhere () u pred assignment + pred = ExpBinary () u GT (varGen "temp") (intGen 100) + assignment = StExpressionAssign () u (varGen "temp") exp + st = StWhere () u pred assignment sParser "where (temp > 100) temp = temp - r_temp"`shouldBe'` st describe "Where block" $ do @@ -459,7 +453,7 @@ it "parses logical if statement" $ do let assignment = StExpressionAssign () u (varGen "a") (varGen "b") - let stIf = StIfLogical () u valTrue assignment + stIf = StIfLogical () u valTrue assignment sParser "if (.true.) a = b" `shouldBe'` stIf it "parses arithmetic if statement" $ do @@ -511,14 +505,14 @@ describe "Do" $ do it "parses do statement with label" $ do let assign = StExpressionAssign () u (varGen "i") (intGen 0) - let doSpec = DoSpecification () u assign (intGen 42) Nothing - let st = StDo () u Nothing (Just $ intGen 24) (Just doSpec) + doSpec = DoSpecification () u assign (intGen 42) Nothing + st = StDo () u Nothing (Just $ intGen 24) (Just doSpec) sParser "do 24, i = 0, 42" `shouldBe'` st it "parses do statement without label" $ do let assign = StExpressionAssign () u (varGen "i") (intGen 0) - let doSpec = DoSpecification () u assign (intGen 42) Nothing - let st = StDo () u Nothing Nothing (Just doSpec) + doSpec = DoSpecification () u assign (intGen 42) Nothing + st = StDo () u Nothing Nothing (Just doSpec) sParser "do i = 0, 42" `shouldBe'` st it "parses infinite do" $ do @@ -549,12 +543,12 @@ it "parses computed goto" $ do let list = fromList () [ intGen 10, intGen 20, intGen 30 ] - let st = StGotoComputed () u list (intGen 20) + st = StGotoComputed () u list (intGen 20) sParser "goto (10, 20, 30) 20" `shouldBe'` st it "parses assigned goto" $ do let list = fromList () [ intGen 10, intGen 20, intGen 30 ] - let st = StGotoAssigned () u (varGen "i") (Just list) + st = StGotoAssigned () u (varGen "i") (Just list) sParser "goto i, (10, 20, 30)" `shouldBe'` st it "parses label assignment" $ do @@ -568,20 +562,20 @@ it "parses write with implied do" $ do let cp1 = ControlPair () u Nothing (intGen 10) - let cp2 = ControlPair () u (Just "format") (varGen "x") - let ciList = fromList () [ cp1, cp2 ] - let assign = StExpressionAssign () u (varGen "i") (intGen 1) - let doSpec = DoSpecification () u assign (intGen 42) (Just $ intGen 2) - let alist = fromList () [ varGen "i", varGen "j" ] - let outList = fromList () [ ExpImpliedDo () u alist doSpec ] - let st = StWrite () u ciList (Just outList) + cp2 = ControlPair () u (Just "format") (varGen "x") + ciList = fromList () [ cp1, cp2 ] + assign = StExpressionAssign () u (varGen "i") (intGen 1) + doSpec = DoSpecification () u assign (intGen 42) (Just $ intGen 2) + alist = fromList () [ varGen "i", varGen "j" ] + outList = fromList () [ ExpImpliedDo () u alist doSpec ] + st = StWrite () u ciList (Just outList) sParser "write (10, FORMAT = x) (i, j, i = 1, 42, 2)" `shouldBe'` st it "parses use statement with renames" $ do let renames = fromList () [ UseRename () u (varGen "sprod") (varGen "prod") , UseRename () u (varGen "a") (varGen "b") ] - let st = StUse () u (varGen "stats_lib") Nothing Permissive (Just renames) + st = StUse () u (varGen "stats_lib") Nothing Permissive (Just renames) sParser "use stats_lib, sprod => prod, a => b" `shouldBe'` st it "parses use statement with only list" $ do @@ -590,7 +584,7 @@ , UseRename () u (varGen "b") (varGen "c") , UseID () u (ExpValue () u (ValOperator "+")) , UseID () u (ExpValue () u ValAssignment) ] - let st = StUse () u (varGen "stats_lib") Nothing Exclusive (Just onlys) + st = StUse () u (varGen "stats_lib") Nothing Exclusive (Just onlys) sParser "use stats_lib, only: a, b => c, operator(+), assignment(=)" `shouldBe'` st specFreeFormCommon sParser eParser diff --git a/test/Language/Fortran/Parser/Fortran95Spec.hs b/test/Language/Fortran/Parser/Fortran95Spec.hs --- a/test/Language/Fortran/Parser/Fortran95Spec.hs +++ b/test/Language/Fortran/Parser/Fortran95Spec.hs @@ -228,8 +228,8 @@ ] ] declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing - , DeclVariable () u (varGen "y") Nothing Nothing ] + [ declVariable () u (varGen "x") Nothing Nothing + , declVariable () u (varGen "y") Nothing Nothing ] expected = StDeclaration () u typeSpec (Just attrs) declarators stStr = "real, external, intent (out), dimension (3:10) :: x, y" sParser stStr `shouldBe'` expected @@ -237,8 +237,8 @@ it "parses declaration with old syntax" $ do let typeSpec = TypeSpec () u TypeLogical Nothing declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing - , DeclVariable () u (varGen "y") Nothing Nothing ] + [ declVariable () u (varGen "x") Nothing Nothing + , declVariable () u (varGen "y") Nothing Nothing ] expected = StDeclaration () u typeSpec Nothing declarators stStr = "logical x, y" sParser stStr `shouldBe'` expected @@ -247,7 +247,7 @@ let typeSpec = TypeSpec () u TypeComplex Nothing init' = ExpValue () u (ValComplex (intGen 24) (realGen (42.0::Double))) declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing (Just init') ] + [ declVariable () u (varGen "x") Nothing (Just init') ] expected = StDeclaration () u typeSpec Nothing declarators stStr = "complex :: x = (24, 42.0)" sParser stStr `shouldBe'` expected @@ -255,7 +255,7 @@ it "parses declaration of custom type" $ do let typeSpec = TypeSpec () u (TypeCustom "meinetype") Nothing declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing ] + [ declVariable () u (varGen "x") Nothing Nothing ] expected = StDeclaration () u typeSpec Nothing declarators stStr = "type (MeineType) :: x" sParser stStr `shouldBe'` expected @@ -264,7 +264,7 @@ let selector = Selector () u Nothing (Just $ varGen "hello") typeSpec = TypeSpec () u TypeInteger (Just selector) declarators = AList () u - [ DeclVariable () u (varGen "x") Nothing Nothing ] + [ declVariable () u (varGen "x") Nothing Nothing ] expected = StDeclaration () u typeSpec Nothing declarators stStr = "integer (hello) :: x" sParser stStr `shouldBe'` expected @@ -302,8 +302,8 @@ sParser stStr `shouldBe'` expected it "parses parameter statement" $ do - let ass1 = DeclVariable () u (varGen "x") Nothing (Just $ intGen 10) - ass2 = DeclVariable () u (varGen "y") Nothing (Just $ intGen 20) + let ass1 = declVariable () u (varGen "x") Nothing (Just $ intGen 10) + ass2 = declVariable () u (varGen "y") Nothing (Just $ intGen 20) expected = StParameter () u (fromList () [ ass1, ass2 ]) sParser "parameter (x = 10, y = 20)" `shouldBe'` expected @@ -628,33 +628,33 @@ let renames = fromList () [ UseRename () u (varGen "sprod") (varGen "prod") , UseRename () u (varGen "a") (varGen "b") ] - let st = StUse () u (varGen "stats_lib") Nothing Permissive (Just renames) + st = StUse () u (varGen "stats_lib") Nothing Permissive (Just renames) sParser "use stats_lib, sprod => prod, a => b" `shouldBe'` st it "parses value decl" $ do - let decls = [DeclVariable () u (varGen "a") Nothing Nothing, DeclVariable () u (varGen "b") Nothing Nothing] - let st = StValue () u (AList () u decls) + let decls = [declVarGen "a", declVarGen "b"] + st = StValue () u (AList () u decls) sParser "value a, b" `shouldBe'` st sParser "value :: a, b" `shouldBe'` st it "parses value attribute" $ do - let decls = [DeclVariable () u (varGen "a") Nothing Nothing, DeclVariable () u (varGen "b") Nothing Nothing] - let ty = TypeSpec () u TypeInteger Nothing - let attrs = [AttrValue () u] - let st = StDeclaration () u ty (Just (AList () u attrs)) (AList () u decls) + let decls = [declVarGen "a", declVarGen "b"] + ty = TypeSpec () u TypeInteger Nothing + attrs = [AttrValue () u] + st = StDeclaration () u ty (Just (AList () u attrs)) (AList () u decls) sParser "integer, value :: a, b" `shouldBe'` st it "parses volatile decl" $ do - let decls = [DeclVariable () u (varGen "a") Nothing Nothing, DeclVariable () u (varGen "b") Nothing Nothing] - let st = StVolatile () u (AList () u decls) + let decls = [declVarGen "a", declVarGen "b"] + st = StVolatile () u (AList () u decls) sParser "volatile a, b" `shouldBe'` st sParser "volatile :: a, b" `shouldBe'` st it "parses volatile attribute" $ do - let decls = [DeclVariable () u (varGen "a") Nothing Nothing, DeclVariable () u (varGen "b") Nothing Nothing] - let ty = TypeSpec () u TypeInteger Nothing - let attrs = [AttrVolatile () u] - let st = StDeclaration () u ty (Just (AList () u attrs)) (AList () u decls) + let decls = [declVarGen "a", declVarGen "b"] + ty = TypeSpec () u TypeInteger Nothing + attrs = [AttrVolatile () u] + st = StDeclaration () u ty (Just (AList () u attrs)) (AList () u decls) sParser "integer, volatile :: a, b" `shouldBe'` st specFreeFormCommon sParser eParser diff --git a/test/Language/Fortran/Parser/FreeFormCommon.hs b/test/Language/Fortran/Parser/FreeFormCommon.hs --- a/test/Language/Fortran/Parser/FreeFormCommon.hs +++ b/test/Language/Fortran/Parser/FreeFormCommon.hs @@ -44,7 +44,7 @@ expected = StDeclaration () u typeSpec Nothing decls typeSpec = TypeSpec () u TypeInteger Nothing decls = AList () u - [ DeclVariable () u (varGen "x") (Just (intGen 8)) Nothing ] + [ declVariable () u (varGen "x") (Just (intGen 8)) Nothing ] sParser stStr `shouldBe'` expected it "parses array declaration with nonstandard kind param (non-CHAR)" $ do @@ -52,7 +52,7 @@ expected = StDeclaration () u typeSpec Nothing decls typeSpec = TypeSpec () u TypeInteger Nothing decls = AList () u - [ DeclArray () u (varGen "x") dims (Just (intGen 8)) Nothing ] + [ declArray () u (varGen "x") dims (Just (intGen 8)) Nothing ] dims = AList () u [ DimensionDeclarator () u Nothing (Just (intGen 2)) ] sParser stStr `shouldBe'` expected @@ -62,7 +62,7 @@ expected = StDeclaration () u typeSpec Nothing decls typeSpec = TypeSpec () u TypeInteger Nothing decls = AList () u - [ DeclArray () u (varGen "x") dims (Just (intGen 8)) Nothing ] + [ declArray () u (varGen "x") dims (Just (intGen 8)) Nothing ] dims = AList () u [ DimensionDeclarator () u Nothing (Just (intGen 2)) ] sParser stStr `shouldBe'` expected diff --git a/test/Language/Fortran/PrettyPrintSpec.hs b/test/Language/Fortran/PrettyPrintSpec.hs --- a/test/Language/Fortran/PrettyPrintSpec.hs +++ b/test/Language/Fortran/PrettyPrintSpec.hs @@ -120,8 +120,8 @@ let typeSpec = TypeSpec () u TypeCharacter (Just sel) let attrs = [ AttrIntent () u In , AttrPointer () u ] let declList = - [ DeclVariable () u (varGen "x") Nothing (Just $ intGen 42) - , DeclVariable () u (varGen "y") (Just $ intGen 3) Nothing ] + [ Declarator () u (varGen "x") ScalarDecl Nothing (Just $ intGen 42) + , Declarator () u (varGen "y") ScalarDecl (Just $ intGen 3) Nothing ] let st = StDeclaration () u typeSpec (Just $ AList () u attrs) (AList () u declList) @@ -132,7 +132,7 @@ let typeSpec = TypeSpec () u TypeInteger Nothing let dds = [ DimensionDeclarator () u Nothing (Just $ intGen 5) ] let declList = - [ DeclArray () u (varGen "x") (AList () u dds) Nothing + [ Declarator () u (varGen "x") (ArrayDecl (AList () u dds)) Nothing (Just . initGen $ map intGen [1..5]) ] let st = StDeclaration () u typeSpec Nothing (AList () u declList) @@ -173,8 +173,8 @@ describe "Parameter" $ it "prints vanilla statement" $ do - let decls = [ DeclVariable () u (varGen "x") Nothing (Just $ intGen 42) - , DeclVariable () u (varGen "y") Nothing (Just $ intGen 24) + let decls = [ Declarator () u (varGen "x") ScalarDecl Nothing (Just $ intGen 42) + , Declarator () u (varGen "y") ScalarDecl Nothing (Just $ intGen 24) ] let st = StParameter () u (AList () u decls) pprint Fortran90 st Nothing `shouldBe` "parameter (x = 42, y = 24)" diff --git a/test/Language/Fortran/Transformation/Disambiguation/FunctionSpec.hs b/test/Language/Fortran/Transformation/Disambiguation/FunctionSpec.hs --- a/test/Language/Fortran/Transformation/Disambiguation/FunctionSpec.hs +++ b/test/Language/Fortran/Transformation/Disambiguation/FunctionSpec.hs @@ -59,11 +59,11 @@ ex1pu1bs :: [Block ()] ex1pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclArray () u (varGen "b") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing - , DeclVariable () u (varGen "c") Nothing Nothing ])) + [ declVarGen "a" + , Declarator () u (varGen "b") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing + , declVarGen "c" ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "a") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "a") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing ])) , BlStatement () u Nothing (StExpressionAssign () u (ExpSubscript () u (varGen "a") (AList () u [ ixSinGen 1 ])) (intGen 1)) , BlStatement () u Nothing (StExpressionAssign () u @@ -82,11 +82,11 @@ expectedEx1pu1bs :: [Block ()] expectedEx1pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclArray () u (varGen "b") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ]) Nothing Nothing - , DeclVariable () u (varGen "c") Nothing Nothing ])) + [ declVarGen "a" + , Declarator () u (varGen "b") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing + , declVarGen "c" ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "a") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "a") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 1) ])) Nothing Nothing ])) , BlStatement () u Nothing (StExpressionAssign () u (ExpSubscript () u (varGen "a") (AList () u [ ixSinGen 1 ])) (intGen 1)) , BlStatement () u Nothing (StExpressionAssign () u @@ -203,8 +203,8 @@ ex4pu1bs :: [Block ()] ex4pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclVariable () u (varGen "f") Nothing Nothing ])) + [ declVarGen "a" + , declVarGen "f" ])) , BlStatement () u Nothing (StExpressionAssign () u (varGen "a") (ExpSubscript () u (varGen "f") (AList () u [ ixSinGen 1 ]))) ] @@ -216,8 +216,8 @@ expectedEx4pu1bs :: [Block ()] expectedEx4pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - , DeclVariable () u (varGen "f") Nothing Nothing ])) + [ declVarGen "a" + , declVarGen "f" ])) , BlStatement () u Nothing (StExpressionAssign () u (varGen "a") (ExpFunctionCall () u (ExpValue () u $ ValVariable "f") @@ -237,8 +237,7 @@ ex5pu1bs :: [Block ()] ex5pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing - ])) + [ declVarGen "a" ])) , BlStatement () u Nothing (StExpressionAssign () u (varGen "a") (ExpSubscript () u (varGen "f") (AList () u [ ixSinGen 1 ]))) ] @@ -250,7 +249,7 @@ expectedEx5pu1bs :: [Block ()] expectedEx5pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing ])) + [ declVarGen "a" ])) , BlStatement () u Nothing (StExpressionAssign () u (varGen "a") (ExpFunctionCall () u (ExpValue () u $ ValVariable "f") @@ -271,10 +270,10 @@ ex6pu1bs :: [Block ()] ex6pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing + [ declVarGen "a" ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "f") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 10 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "f") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 10) ])) Nothing Nothing ])) , BlStatement () u Nothing (StExpressionAssign () u (varGen "a") (ExpSubscript () u (varGen "f") (AList () u [ ixSinGen 1 ]))) ] @@ -286,9 +285,9 @@ expectedEx6pu1bs :: [Block ()] expectedEx6pu1bs = [ BlStatement () u Nothing (StDeclaration () u (TypeSpec () u TypeInteger Nothing) Nothing (AList () u - [ DeclVariable () u (varGen "a") Nothing Nothing ])) + [ Declarator () u (varGen "a") ScalarDecl Nothing Nothing ])) , BlStatement () u Nothing (StDimension () u (AList () u - [ DeclArray () u (varGen "f") (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 10 ) ]) Nothing Nothing ])) + [ Declarator () u (varGen "f") (ArrayDecl (AList () u [ DimensionDeclarator () u Nothing (Just $ intGen 10 ) ])) Nothing Nothing ])) , BlStatement () u Nothing (StExpressionAssign () u (varGen "a") (ExpSubscript () u (varGen "f") (AList () u [ ixSinGen 1 ]))) ] diff --git a/test/TestUtil.hs b/test/TestUtil.hs --- a/test/TestUtil.hs +++ b/test/TestUtil.hs @@ -37,7 +37,7 @@ varGen str = ExpValue () u $ ValVariable str declVarGen :: String -> Declarator () -declVarGen str = DeclVariable () u (varGen str) Nothing Nothing +declVarGen str = Declarator () u (varGen str) ScalarDecl Nothing Nothing intGen :: Integer -> Expression () intGen i = ExpValue () u $ ValInteger (show i) Nothing @@ -62,6 +62,12 @@ assVal :: Expression () assVal = ExpValue () u ValAssignment + +declVariable :: a -> SrcSpan -> Expression a -> Maybe (Expression a) -> Maybe (Expression a) -> Declarator a +declVariable a ss v mLen mVal = Declarator a ss v ScalarDecl mLen mVal + +declArray :: a -> SrcSpan -> Expression a -> AList DimensionDeclarator a -> Maybe (Expression a) -> Maybe (Expression a) -> Declarator a +declArray a ss v dims mLen mVal = Declarator a ss v (ArrayDecl dims) mLen mVal ixSinGen :: Integer -> Index () ixSinGen i = IxSingle () u Nothing (intGen i)