{-|
Note that labeled (nonblock) DO grouping must be done before block DO grouping.
-}

module Language.Fortran.Transformation.Grouping ( groupForall
                                                , groupDo
                                                , groupLabeledDo
                                                ) where

import Language.Fortran.AST
import Language.Fortran.Util.Position
import Language.Fortran.Analysis
import Language.Fortran.Transformation.Monad

import Data.Data
import Data.List (intercalate)
import Data.Generics.Uniplate.Operations

type ABlocks a = [ Block (Analysis a) ]

genericGroup :: Data a => (ABlocks a -> ABlocks a) -> (Statement (Analysis a) -> Bool) -> Transform a ()
genericGroup :: forall a.
Data a =>
(ABlocks a -> ABlocks a)
-> (Statement (Analysis a) -> Bool) -> Transform a ()
genericGroup ABlocks a -> ABlocks a
groupingFunction Statement (Analysis a) -> Bool
checkingFunction = do
    ProgramFile (Analysis a)
pf <- forall a. Transform a (ProgramFile (Analysis a))
getProgramFile
    let pf' :: ProgramFile (Analysis a)
pf' = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ABlocks a -> ABlocks a
groupingFunction ProgramFile (Analysis a)
pf
        bad :: [Statement (Analysis a)]
bad = forall a. (a -> Bool) -> [a] -> [a]
filter Statement (Analysis a) -> Bool
checkingFunction forall a b. (a -> b) -> a -> b
$ forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf'
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Statement (Analysis a)]
bad
      then forall a. ProgramFile (Analysis a) -> Transform a ()
putProgramFile ProgramFile (Analysis a)
pf'
      else let spans :: [[Char]]
spans = [ Position -> [Char]
apparentFilePath Position
p1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SrcSpan
ss | Statement (Analysis a)
b <- [Statement (Analysis a)]
bad, let ss :: SrcSpan
ss@(SrcSpan Position
p1 Position
_) = forall a. Spanned a => a -> SrcSpan
getSpan Statement (Analysis a)
b ] in
             forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Mis-matched grouping statements at these position(s): " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
spans

--------------------------------------------------------------------------------
-- Grouping FORALL statement blocks into FORALL blocks in entire parse tree
--------------------------------------------------------------------------------
groupForall :: Data a => Transform a ()
groupForall :: forall a. Data a => Transform a ()
groupForall = forall a.
Data a =>
(ABlocks a -> ABlocks a)
-> (Statement (Analysis a) -> Bool) -> Transform a ()
genericGroup forall a. ABlocks a -> ABlocks a
groupForall' forall a. Statement a -> Bool
isForall


groupForall' :: ABlocks a -> ABlocks a
groupForall' :: forall a. ABlocks a -> ABlocks a
groupForall' [] = []
groupForall' (Block (Analysis a)
b:ABlocks a
bs) = Block (Analysis a)
b' forall a. a -> [a] -> [a]
: ABlocks a
bs'
  where
    (Block (Analysis a)
b', ABlocks a
bs') = case Block (Analysis a)
b of
      BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
label Statement (Analysis a)
st
        | StForall Analysis a
_ SrcSpan
_ Maybe [Char]
mTarget ForallHeader (Analysis a)
header <- Statement (Analysis a)
st ->
          let ( ABlocks a
blocks, ABlocks a
leftOverBlocks, Maybe (Expression (Analysis a))
endLabel ) =
               forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonForallBlocks ABlocks a
groupedBlocks Maybe [Char]
mTarget
          in ( forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> ForallHeader a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlForall Analysis a
a (forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
s ABlocks a
blocks) Maybe (Expression (Analysis a))
label Maybe [Char]
mTarget ForallHeader (Analysis a)
header ABlocks a
blocks Maybe (Expression (Analysis a))
endLabel
             , ABlocks a
leftOverBlocks)
        | StForallStatement Analysis a
_ SrcSpan
_ ForallHeader (Analysis a)
header Statement (Analysis a)
st' <- Statement (Analysis a)
st ->
          let block :: Block (Analysis a)
block = forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a (forall a. Spanned a => a -> SrcSpan
getSpan Statement (Analysis a)
st') forall a. Maybe a
Nothing Statement (Analysis a)
st' in
          ( forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> ForallHeader a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlForall Analysis a
a (forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
s Statement (Analysis a)
st') Maybe (Expression (Analysis a))
label forall a. Maybe a
Nothing ForallHeader (Analysis a)
header [Block (Analysis a)
block] forall a. Maybe a
Nothing, ABlocks a
groupedBlocks )
      Block (Analysis a)
b'' | forall a. Block (Analysis a) -> Bool
containsGroups Block (Analysis a)
b'' ->
        ( forall a.
(ABlocks a -> ABlocks a)
-> Block (Analysis a) -> Block (Analysis a)
applyGroupingToSubblocks forall a. ABlocks a -> ABlocks a
groupForall' Block (Analysis a)
b'', ABlocks a
groupedBlocks )
      Block (Analysis a)
_ -> (Block (Analysis a)
b, ABlocks a
groupedBlocks)
    groupedBlocks :: ABlocks a
groupedBlocks = forall a. ABlocks a -> ABlocks a
groupForall' ABlocks a
bs

collectNonForallBlocks :: ABlocks a -> Maybe String
                          -> ( ABlocks a
                             , ABlocks a
                             , Maybe (Expression (Analysis a)) )
collectNonForallBlocks :: forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonForallBlocks ABlocks a
blocks Maybe [Char]
mNameTarget =
  case ABlocks a
blocks of
    BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mLabel (StEndForall Analysis a
_ SrcSpan
_ Maybe [Char]
mName):ABlocks a
rest
      | Maybe [Char]
mName forall a. Eq a => a -> a -> Bool
== Maybe [Char]
mNameTarget -> ([], ABlocks a
rest, Maybe (Expression (Analysis a))
mLabel)
      | Bool
otherwise ->
        forall a. HasCallStack => [Char] -> a
error [Char]
"Forall block name does not match that of the end statement."
    Block (Analysis a)
b:ABlocks a
bs ->
      let (ABlocks a
bs', ABlocks a
rest, Maybe (Expression (Analysis a))
mLabel) = forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonForallBlocks ABlocks a
bs Maybe [Char]
mNameTarget
      in (Block (Analysis a)
b forall a. a -> [a] -> [a]
: ABlocks a
bs', ABlocks a
rest, Maybe (Expression (Analysis a))
mLabel)
    ABlocks a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Premature file ending while parsing structured forall block."

isForall :: Statement a -> Bool
isForall :: forall a. Statement a -> Bool
isForall (StForall{}) = Bool
True
isForall (StForallStatement{}) = Bool
True
isForall Statement a
_ = Bool
False


--------------------------------------------------------------------------------
-- Grouping new do statement blocks into do blocks in entire parse tree
--------------------------------------------------------------------------------

groupDo :: Data a => Transform a ()
groupDo :: forall a. Data a => Transform a ()
groupDo = forall a.
Data a =>
(ABlocks a -> ABlocks a)
-> (Statement (Analysis a) -> Bool) -> Transform a ()
genericGroup forall a. ABlocks a -> ABlocks a
groupDo' forall a. Statement a -> Bool
isDo

groupDo' :: ABlocks a -> ABlocks a
groupDo' :: forall a. ABlocks a -> ABlocks a
groupDo' [ ] = [ ]
groupDo' (Block (Analysis a)
b:[Block (Analysis a)]
bs) = Block (Analysis a)
b' forall a. a -> [a] -> [a]
: [Block (Analysis a)]
bs'
  where
    (Block (Analysis a)
b', [Block (Analysis a)]
bs') = case Block (Analysis a)
b of
      BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
label Statement (Analysis a)
st
        -- Do While statement
        | StDoWhile Analysis a
_ SrcSpan
_ Maybe [Char]
mTarget Maybe (Expression (Analysis a))
Nothing Expression (Analysis a)
condition <- Statement (Analysis a)
st ->
          let ( [Block (Analysis a)]
blocks, [Block (Analysis a)]
leftOverBlocks, Maybe (Expression (Analysis a))
endLabel, Statement (Analysis a)
stEnd ) =
                forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)),
    Statement (Analysis a))
collectNonDoBlocks [Block (Analysis a)]
groupedBlocks Maybe [Char]
mTarget
          in ( forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Maybe (Expression a)
-> Expression a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDoWhile Analysis a
a (forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
s Statement (Analysis a)
stEnd) Maybe (Expression (Analysis a))
label Maybe [Char]
mTarget forall a. Maybe a
Nothing Expression (Analysis a)
condition [Block (Analysis a)]
blocks Maybe (Expression (Analysis a))
endLabel
             , [Block (Analysis a)]
leftOverBlocks)
        -- Vanilla do statement
        | StDo Analysis a
_ SrcSpan
_ Maybe [Char]
mName Maybe (Expression (Analysis a))
Nothing Maybe (DoSpecification (Analysis a))
doSpec <- Statement (Analysis a)
st ->
          let ( [Block (Analysis a)]
blocks, [Block (Analysis a)]
leftOverBlocks, Maybe (Expression (Analysis a))
endLabel, Statement (Analysis a)
stEnd ) =
                forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)),
    Statement (Analysis a))
collectNonDoBlocks [Block (Analysis a)]
groupedBlocks Maybe [Char]
mName
          in ( forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Maybe (Expression a)
-> Maybe (DoSpecification a)
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDo Analysis a
a (forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
s Statement (Analysis a)
stEnd) Maybe (Expression (Analysis a))
label Maybe [Char]
mName forall a. Maybe a
Nothing Maybe (DoSpecification (Analysis a))
doSpec [Block (Analysis a)]
blocks Maybe (Expression (Analysis a))
endLabel
             , [Block (Analysis a)]
leftOverBlocks)
      Block (Analysis a)
b'' | forall a. Block (Analysis a) -> Bool
containsGroups Block (Analysis a)
b'' ->
        ( forall a.
(ABlocks a -> ABlocks a)
-> Block (Analysis a) -> Block (Analysis a)
applyGroupingToSubblocks forall a. ABlocks a -> ABlocks a
groupDo' Block (Analysis a)
b'', [Block (Analysis a)]
groupedBlocks )
      Block (Analysis a)
_ -> ( Block (Analysis a)
b, [Block (Analysis a)]
groupedBlocks )
    groupedBlocks :: [Block (Analysis a)]
groupedBlocks = forall a. ABlocks a -> ABlocks a
groupDo' [Block (Analysis a)]
bs -- Assume everything to the right is grouped.

collectNonDoBlocks :: ABlocks a -> Maybe String
                   -> ( ABlocks a
                      , ABlocks a
                      , Maybe (Expression (Analysis a))
                      , Statement (Analysis a) )
collectNonDoBlocks :: forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)),
    Statement (Analysis a))
collectNonDoBlocks ABlocks a
blocks Maybe [Char]
mNameTarget =
  case ABlocks a
blocks of
    BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
mLabel st :: Statement (Analysis a)
st@(StEnddo Analysis a
_ SrcSpan
_ Maybe [Char]
mName):ABlocks a
rest
      | Maybe [Char]
mName forall a. Eq a => a -> a -> Bool
== Maybe [Char]
mNameTarget -> ([ ], ABlocks a
rest, Maybe (Expression (Analysis a))
mLabel, Statement (Analysis a)
st)
      | Bool
otherwise ->
          forall a. HasCallStack => [Char] -> a
error [Char]
"Do block name does not match that of the end statement."
    Block (Analysis a)
b:ABlocks a
bs ->
      let (ABlocks a
bs', ABlocks a
rest, Maybe (Expression (Analysis a))
mLabel, Statement (Analysis a)
stEnd) = forall a.
ABlocks a
-> Maybe [Char]
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)),
    Statement (Analysis a))
collectNonDoBlocks ABlocks a
bs Maybe [Char]
mNameTarget
      in (Block (Analysis a)
b forall a. a -> [a] -> [a]
: ABlocks a
bs', ABlocks a
rest, Maybe (Expression (Analysis a))
mLabel, Statement (Analysis a)
stEnd)
    ABlocks a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Premature file ending while parsing structured do block."

isDo :: Statement a -> Bool
isDo :: forall a. Statement a -> Bool
isDo Statement a
s = case Statement a
s of
  StDo a
_ SrcSpan
_ Maybe [Char]
_ Maybe (Expression a)
Nothing Maybe (DoSpecification a)
_      -> Bool
True
  StDoWhile a
_ SrcSpan
_ Maybe [Char]
_ Maybe (Expression a)
Nothing Expression a
_ -> Bool
True
  StEnddo{}                 -> Bool
True
  Statement a
_                         -> Bool
False

--------------------------------------------------------------------------------
-- Grouping labeled do statement blocks into do blocks in entire parse tree
--------------------------------------------------------------------------------

groupLabeledDo :: Data a => Transform a ()
groupLabeledDo :: forall a. Data a => Transform a ()
groupLabeledDo = forall a.
Data a =>
(ABlocks a -> ABlocks a)
-> (Statement (Analysis a) -> Bool) -> Transform a ()
genericGroup forall a. ABlocks a -> ABlocks a
groupLabeledDo' forall a. Statement a -> Bool
isLabeledDo

groupLabeledDo' :: ABlocks a -> ABlocks a
groupLabeledDo' :: forall a. ABlocks a -> ABlocks a
groupLabeledDo' [ ] = [ ]
groupLabeledDo' (Block (Analysis a)
b:ABlocks a
bs) = Block (Analysis a)
b' forall a. a -> [a] -> [a]
: ABlocks a
bs'
  where
    (Block (Analysis a)
b', ABlocks a
bs') = case Block (Analysis a)
b of
      BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
label
        (StDo Analysis a
_ SrcSpan
_ Maybe [Char]
mn tl :: Maybe (Expression (Analysis a))
tl@Just{} Maybe (DoSpecification (Analysis a))
doSpec) ->
          let ( ABlocks a
blocks, ABlocks a
leftOverBlocks, Maybe (Expression (Analysis a))
lastLabel ) =
                forall a.
Maybe (Expression (Analysis a))
-> ABlocks a
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonLabeledDoBlocks Maybe (Expression (Analysis a))
tl ABlocks a
groupedBlocks
          in ( forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Maybe (Expression a)
-> Maybe (DoSpecification a)
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDo Analysis a
a (forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
s ABlocks a
blocks) Maybe (Expression (Analysis a))
label Maybe [Char]
mn Maybe (Expression (Analysis a))
tl Maybe (DoSpecification (Analysis a))
doSpec ABlocks a
blocks Maybe (Expression (Analysis a))
lastLabel
             , ABlocks a
leftOverBlocks )
      BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
label
        (StDoWhile Analysis a
_ SrcSpan
_ Maybe [Char]
mn tl :: Maybe (Expression (Analysis a))
tl@Just{} Expression (Analysis a)
cond) ->
          let ( ABlocks a
blocks, ABlocks a
leftOverBlocks, Maybe (Expression (Analysis a))
lastLabel ) =
                forall a.
Maybe (Expression (Analysis a))
-> ABlocks a
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonLabeledDoBlocks Maybe (Expression (Analysis a))
tl ABlocks a
groupedBlocks
          in ( forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Maybe (Expression a)
-> Expression a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDoWhile Analysis a
a (forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
s ABlocks a
blocks) Maybe (Expression (Analysis a))
label Maybe [Char]
mn Maybe (Expression (Analysis a))
tl Expression (Analysis a)
cond ABlocks a
blocks Maybe (Expression (Analysis a))
lastLabel
             , ABlocks a
leftOverBlocks )
      Block (Analysis a)
b'' | forall a. Block (Analysis a) -> Bool
containsGroups Block (Analysis a)
b'' ->
        ( forall a.
(ABlocks a -> ABlocks a)
-> Block (Analysis a) -> Block (Analysis a)
applyGroupingToSubblocks forall a. ABlocks a -> ABlocks a
groupLabeledDo' Block (Analysis a)
b'', ABlocks a
groupedBlocks )
      Block (Analysis a)
_ -> (Block (Analysis a)
b, ABlocks a
groupedBlocks)

    -- Assume everything to the right is grouped.
    groupedBlocks :: ABlocks a
groupedBlocks = forall a. ABlocks a -> ABlocks a
groupLabeledDo' ABlocks a
bs


collectNonLabeledDoBlocks :: Maybe (Expression (Analysis a)) -> ABlocks a
                          -> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonLabeledDoBlocks :: forall a.
Maybe (Expression (Analysis a))
-> ABlocks a
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonLabeledDoBlocks Maybe (Expression (Analysis a))
targetLabel ABlocks a
blocks =
  case ABlocks a
blocks of
    -- Didn't find a statement with matching label; don't group
    [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"Malformed labeled DO group."
    Block (Analysis a)
b:ABlocks a
bs
      | forall a. Maybe (Expression a) -> Maybe (Expression a) -> Bool
compLabel (forall (f :: * -> *) a. Labeled f => f a -> Maybe (Expression a)
getLastLabel Block (Analysis a)
b) Maybe (Expression (Analysis a))
targetLabel -> (ABlocks a
b1, ABlocks a
bs, forall (f :: * -> *) a. Labeled f => f a -> Maybe (Expression a)
getLastLabel Block (Analysis a)
b)
      | Bool
otherwise                              -> (Block (Analysis a)
b forall a. a -> [a] -> [a]
: ABlocks a
bs', ABlocks a
rest, Maybe (Expression (Analysis a))
ll)
      where (ABlocks a
bs', ABlocks a
rest, Maybe (Expression (Analysis a))
ll) = forall a.
Maybe (Expression (Analysis a))
-> ABlocks a
-> (ABlocks a, ABlocks a, Maybe (Expression (Analysis a)))
collectNonLabeledDoBlocks Maybe (Expression (Analysis a))
targetLabel ABlocks a
bs
            b1 :: ABlocks a
b1 = case Block (Analysis a)
b of BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ StEnddo{}    -> []
                           BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ StContinue{} -> []
                           Block (Analysis a)
_                              -> [Block (Analysis a)
b]


compLabel :: Maybe (Expression a) -> Maybe (Expression a) -> Bool
compLabel :: forall a. Maybe (Expression a) -> Maybe (Expression a) -> Bool
compLabel (Just (ExpValue a
_ SrcSpan
_ (ValInteger [Char]
l1 Maybe (KindParam a)
_)))
          (Just (ExpValue a
_ SrcSpan
_ (ValInteger [Char]
l2 Maybe (KindParam a)
_))) = [Char] -> [Char]
strip [Char]
l1 forall a. Eq a => a -> a -> Bool
== [Char] -> [Char]
strip [Char]
l2
compLabel Maybe (Expression a)
_ Maybe (Expression a)
_ = Bool
False

strip :: String -> String
strip :: [Char] -> [Char]
strip = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'0')

isLabeledDo :: Statement a -> Bool
isLabeledDo :: forall a. Statement a -> Bool
isLabeledDo Statement a
s = case Statement a
s of
  StDo a
_ SrcSpan
_ Maybe [Char]
_ Just{} Maybe (DoSpecification a)
_       -> Bool
True
  StDoWhile a
_ SrcSpan
_ Maybe [Char]
_ Just{} Expression a
_  -> Bool
True
  Statement a
_                         -> Bool
False

--------------------------------------------------------------------------------
-- Helpers for grouping of structured blocks with more blocks inside.
--------------------------------------------------------------------------------

containsGroups :: Block (Analysis a) -> Bool
containsGroups :: forall a. Block (Analysis a) -> Bool
containsGroups Block (Analysis a)
b =
  case Block (Analysis a)
b of
    BlStatement{} -> Bool
False
    BlIf{}        -> Bool
True
    BlCase{}      -> Bool
True
    BlDo{}        -> Bool
True
    BlDoWhile{}   -> Bool
True
    BlInterface{} -> Bool
False
    BlComment{}   -> Bool
False
    BlForall{}    -> Bool
True
    BlAssociate{} -> Bool
True

applyGroupingToSubblocks :: (ABlocks a -> ABlocks a) -> Block (Analysis a) -> Block (Analysis a)
applyGroupingToSubblocks :: forall a.
(ABlocks a -> ABlocks a)
-> Block (Analysis a) -> Block (Analysis a)
applyGroupingToSubblocks ABlocks a -> ABlocks a
f Block (Analysis a)
b
  | BlStatement{} <- Block (Analysis a)
b =
      forall a. HasCallStack => [Char] -> a
error [Char]
"Individual statements do not have subblocks. Must not occur."
  | BlIf Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
mn NonEmpty (Expression (Analysis a), ABlocks a)
clauses Maybe (ABlocks a)
elseBlock Maybe (Expression (Analysis a))
el <- Block (Analysis a)
b =
    forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> NonEmpty (Expression a, [Block a])
-> Maybe [Block a]
-> Maybe (Expression a)
-> Block a
BlIf Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
mn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Expression (Analysis a)
cond, ABlocks a
block) -> (Expression (Analysis a)
cond, ABlocks a -> ABlocks a
f ABlocks a
block)) NonEmpty (Expression (Analysis a), ABlocks a)
clauses) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ABlocks a -> ABlocks a
f Maybe (ABlocks a)
elseBlock) Maybe (Expression (Analysis a))
el
  | BlCase Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
mn Expression (Analysis a)
scrutinee [(AList Index (Analysis a), ABlocks a)]
clauses Maybe (ABlocks a)
caseDefault Maybe (Expression (Analysis a))
el <- Block (Analysis a)
b =
    forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Expression a
-> [(AList Index a, [Block a])]
-> Maybe [Block a]
-> Maybe (Expression a)
-> Block a
BlCase Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
mn Expression (Analysis a)
scrutinee (forall a b. (a -> b) -> [a] -> [b]
map (\(AList Index (Analysis a)
range, ABlocks a
block) -> (AList Index (Analysis a)
range, ABlocks a -> ABlocks a
f ABlocks a
block)) [(AList Index (Analysis a), ABlocks a)]
clauses) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ABlocks a -> ABlocks a
f Maybe (ABlocks a)
caseDefault) Maybe (Expression (Analysis a))
el
  | BlDo Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
n Maybe (Expression (Analysis a))
tl Maybe (DoSpecification (Analysis a))
doSpec ABlocks a
blocks     Maybe (Expression (Analysis a))
el <- Block (Analysis a)
b =
    forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Maybe (Expression a)
-> Maybe (DoSpecification a)
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDo Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
n Maybe (Expression (Analysis a))
tl Maybe (DoSpecification (Analysis a))
doSpec (ABlocks a -> ABlocks a
f ABlocks a
blocks) Maybe (Expression (Analysis a))
el
  | BlDoWhile Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
n Maybe (Expression (Analysis a))
tl Expression (Analysis a)
doSpec ABlocks a
blocks     Maybe (Expression (Analysis a))
el <- Block (Analysis a)
b =
    forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> Maybe (Expression a)
-> Expression a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlDoWhile Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l Maybe [Char]
n Maybe (Expression (Analysis a))
tl Expression (Analysis a)
doSpec (ABlocks a -> ABlocks a
f ABlocks a
blocks) Maybe (Expression (Analysis a))
el
  | BlInterface{} <- Block (Analysis a)
b =
      forall a. HasCallStack => [Char] -> a
error [Char]
"Interface blocks do not have groupable subblocks. Must not occur."
  | BlComment{} <- Block (Analysis a)
b =
      forall a. HasCallStack => [Char] -> a
error [Char]
"Comment statements do not have subblocks. Must not occur."
  | BlForall Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
ml Maybe [Char]
mn ForallHeader (Analysis a)
h ABlocks a
blocks Maybe (Expression (Analysis a))
mel <- Block (Analysis a)
b =
    forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> ForallHeader a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlForall Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
ml Maybe [Char]
mn ForallHeader (Analysis a)
h (ABlocks a -> ABlocks a
f ABlocks a
blocks) Maybe (Expression (Analysis a))
mel
  | BlAssociate Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
ml Maybe [Char]
mn AList (ATuple Expression Expression) (Analysis a)
abbrevs ABlocks a
blocks     Maybe (Expression (Analysis a))
mel <- Block (Analysis a)
b =
    forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Maybe [Char]
-> AList (ATuple Expression Expression) a
-> [Block a]
-> Maybe (Expression a)
-> Block a
BlAssociate Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
ml Maybe [Char]
mn AList (ATuple Expression Expression) (Analysis a)
abbrevs (ABlocks a -> ABlocks a
f ABlocks a
blocks) Maybe (Expression (Analysis a))
mel

--------------------------------------------------

-- Local variables:
-- mode: haskell
-- haskell-program-name: "cabal repl"
-- End: