fortran-src 0.7.0 → 0.8.0

raw patch · 29 files changed

+413/−361 lines, 29 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• fortran-src.cabal +1/−1
• src/Language/Fortran/AST.hs +30/−39
• src/Language/Fortran/AST/Boz.hs +33/−3
• src/Language/Fortran/Analysis.hs +2/−4
• src/Language/Fortran/Analysis/BBlocks.hs +9/−9
• src/Language/Fortran/Analysis/DataFlow.hs +2/−2
• src/Language/Fortran/Analysis/Renaming.hs +3/−8
• src/Language/Fortran/Analysis/Types.hs +20/−12
• src/Language/Fortran/Parser/Fortran2003.y +12/−12
• src/Language/Fortran/Parser/Fortran66.y +36/−18
• src/Language/Fortran/Parser/Fortran77.y +13/−12
• src/Language/Fortran/Parser/Fortran90.y +9/−9
• src/Language/Fortran/Parser/Fortran95.y +9/−9
• src/Language/Fortran/PrettyPrint.hs +6/−6
• src/Language/Fortran/Util/ModFile.hs +3/−4
• test/Language/Fortran/AST/BozSpec.hs +6/−0
• test/Language/Fortran/Analysis/RenamingSpec.hs +13/−13
• test/Language/Fortran/Analysis/TypesSpec.hs +11/−11
• test/Language/Fortran/Parser/Fortran2003Spec.hs +25/−25
• test/Language/Fortran/Parser/Fortran66Spec.hs +3/−3
• test/Language/Fortran/Parser/Fortran77/IncludeSpec.hs +1/−1
• test/Language/Fortran/Parser/Fortran77/ParserSpec.hs +19/−19
• test/Language/Fortran/Parser/Fortran90Spec.hs +85/−91
• test/Language/Fortran/Parser/Fortran95Spec.hs +22/−22
• test/Language/Fortran/Parser/FreeFormCommon.hs +3/−3
• test/Language/Fortran/PrettyPrintSpec.hs +5/−5
• test/Language/Fortran/Transformation/Disambiguation/FunctionSpec.hs +18/−19
• test/TestUtil.hs +7/−1

@@ -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

@@ -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 @<https://hackage.haskell.org/package/camfort CamFort>@ project, which uses fortran-src as its front end. category:       Language

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -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) 

@@ -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

@@ -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 

@@ -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

@@ -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

@@ -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 }

@@ -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

@@ -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

@@ -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

@@ -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.

@@ -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

@@ -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"))

@@ -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

@@ -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 

@@ -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 

@@ -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

@@ -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"

@@ -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

@@ -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

@@ -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

@@ -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)"

@@ -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 ]))) ] 

@@ -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)