{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE UndecidableInstances  #-}

module Language.Fortran.PrettyPrint where

import Data.Maybe (isJust, isNothing, listToMaybe)
import Data.List (foldl')

import Prelude hiding (EQ,LT,GT,pred,exp,(<>))

import Language.Fortran.AST
import Language.Fortran.AST.Literal.Real
import Language.Fortran.AST.Literal.Boz
import Language.Fortran.AST.Literal.Complex
import Language.Fortran.Version

import Text.PrettyPrint

tooOld :: FortranVersion -> String -> FortranVersion -> a
tooOld :: forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
currentVersion [Char]
featureName FortranVersion
featureVersion = forall a. [Char] -> a
prettyError forall a b. (a -> b) -> a -> b
$
    [Char]
featureName forall a. [a] -> [a] -> [a]
++ [Char]
" was introduced in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FortranVersion
featureVersion forall a. [a] -> [a] -> [a]
++
    [Char]
". You called pretty print with " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FortranVersion
currentVersion forall a. [a] -> [a] -> [a]
++ [Char]
"."

-- | Continue only if the given version is equal to or older than a "maximum"
--   version, or emit a runtime error.
olderThan :: FortranVersion -> String -> FortranVersion -> a -> a
olderThan :: forall a. FortranVersion -> [Char] -> FortranVersion -> a -> a
olderThan FortranVersion
verMax [Char]
featureName FortranVersion
ver a
cont =
    if   FortranVersion
ver forall a. Ord a => a -> a -> Bool
> FortranVersion
verMax
    then forall a. [Char] -> a
prettyError forall a b. (a -> b) -> a -> b
$
            [Char]
featureName
            forall a. [a] -> [a] -> [a]
++ [Char]
" is only available in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FortranVersion
verMax
            forall a. [a] -> [a] -> [a]
++ [Char]
" or before. You called pretty print with "
            forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FortranVersion
ver forall a. [a] -> [a] -> [a]
++ [Char]
"."
    else a
cont

(<?>) :: Doc -> Doc -> Doc
Doc
doc1 <?> :: Doc -> Doc -> Doc
<?> Doc
doc2 = if Doc
doc1 forall a. Eq a => a -> a -> Bool
== Doc
empty Bool -> Bool -> Bool
|| Doc
doc2 forall a. Eq a => a -> a -> Bool
== Doc
empty then Doc
empty else Doc
doc1 Doc -> Doc -> Doc
<> Doc
doc2
infixl 7 <?>

(<?+>) :: Doc -> Doc -> Doc
Doc
doc1 <?+> :: Doc -> Doc -> Doc
<?+> Doc
doc2 = if Doc
doc1 forall a. Eq a => a -> a -> Bool
== Doc
empty Bool -> Bool -> Bool
|| Doc
doc2 forall a. Eq a => a -> a -> Bool
== Doc
empty then Doc
empty else Doc
doc1 Doc -> Doc -> Doc
<+> Doc
doc2
infixl 7 <?+>

-- Helpers
printMaybe :: (a -> Doc) -> Maybe a -> Doc
printMaybe :: forall a. (a -> Doc) -> Maybe a -> Doc
printMaybe a -> Doc
f = \case Just a
a  -> a -> Doc
f a
a
                     Maybe a
Nothing -> Doc
empty

printIndentedBlockWithPre
    :: FortranVersion -> Indentation -> Doc -> [Block a] -> Doc
printIndentedBlockWithPre :: forall a. FortranVersion -> Indentation -> Doc -> [Block a] -> Doc
printIndentedBlockWithPre FortranVersion
v Indentation
i Doc
doc [Block a]
b =
    Doc
doc Doc -> Doc -> Doc
<> Doc
newline Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
b (Indentation -> Indentation
incIndentation Indentation
i)

newline :: Doc
newline :: Doc
newline = Char -> Doc
char Char
'\n'

type Indentation = Maybe Int

incIndentation :: Indentation -> Indentation
incIndentation :: Indentation -> Indentation
incIndentation Indentation
indentation = (forall a. Num a => a -> a -> a
+Int
2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Indentation
indentation

indent :: Indentation -> Doc -> Doc
indent :: Indentation -> Doc -> Doc
indent Indentation
Nothing Doc
d = Doc
d
indent (Just Int
i) Doc
d = [Char] -> Doc
text (forall a. Int -> a -> [a]
replicate Int
i Char
' ') Doc -> Doc -> Doc
<> Doc
d

overlay :: Doc -> Doc -> Doc
overlay :: Doc -> Doc -> Doc
overlay Doc
top Doc
bottom = [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$ [Char]
top' forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
top') (Doc -> [Char]
render Doc
bottom)
  where top' :: [Char]
top' = Doc -> [Char]
render Doc
top

fixedForm :: Indentation
fixedForm :: Indentation
fixedForm = forall a. a -> Maybe a
Just Int
6

pprintAndRender :: IndentablePretty t => FortranVersion -> t -> Indentation -> String
pprintAndRender :: forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> [Char]
pprintAndRender FortranVersion
v t
t Indentation
i = Doc -> [Char]
render forall a b. (a -> b) -> a -> b
$ forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v t
t Indentation
i

class IndentablePretty t where
    pprint :: FortranVersion -> t -> Indentation -> Doc

instance {-# OVERLAPPABLE #-} Pretty a => IndentablePretty a where
    pprint :: FortranVersion -> a -> Indentation -> Doc
pprint FortranVersion
v a
t Indentation
_ = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v a
t

instance IndentablePretty a => IndentablePretty (Maybe a) where
    pprint :: FortranVersion -> Maybe a -> Indentation -> Doc
pprint FortranVersion
v (Just a
t) Indentation
i = forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v a
t Indentation
i
    pprint FortranVersion
_ Maybe a
Nothing Indentation
_ = Doc
empty

instance IndentablePretty (ProgramFile a) where
    pprint :: FortranVersion -> ProgramFile a -> Indentation -> Doc
pprint FortranVersion
v (ProgramFile MetaInfo
_ [ProgramUnit a]
programUnits) Indentation
i =
      forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
b ProgramUnit a
a -> Doc
b Doc -> Doc -> Doc
<> ProgramUnit a -> Doc
pprintUnit ProgramUnit a
a) Doc
empty [ProgramUnit a]
programUnits
      where
        pprintUnit :: ProgramUnit a -> Doc
pprintUnit ProgramUnit a
pu = forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v ProgramUnit a
pu Indentation
i

instance IndentablePretty [ProgramUnit a] where
    pprint :: FortranVersion -> [ProgramUnit a] -> Indentation -> Doc
pprint FortranVersion
v [ProgramUnit a]
pus Indentation
i = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
b ProgramUnit a
a -> Doc
b Doc -> Doc -> Doc
<?> Doc
newline Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v ProgramUnit a
a Indentation
i) Doc
empty [ProgramUnit a]
pus

instance IndentablePretty (ProgramUnit a) where
    pprint :: FortranVersion -> ProgramUnit a -> Indentation -> Doc
pprint FortranVersion
v (PUMain a
_ SrcSpan
_ Maybe [Char]
mName [Block a]
body Maybe [ProgramUnit a]
mSubs) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77 =
        if forall a. Maybe a -> Bool
isJust Maybe [Char]
mName
          then forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Named main program unit" FortranVersion
Fortran77
          else
            if forall a. Maybe a -> Bool
isJust Maybe [ProgramUnit a]
mSubs
              then forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Subprogram unit" FortranVersion
Fortran90
              else forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
fixedForm Doc -> Doc -> Doc
<>
                   Indentation -> Doc -> Doc
indent Indentation
fixedForm (Doc
"end" Doc -> Doc -> Doc
<> Doc
newline)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90 =
        Indentation -> Doc -> Doc
indent Indentation
fixedForm (Doc
"program" Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<?> Doc
newline) Doc -> Doc -> Doc
<>
        if forall a. Maybe a -> Bool
isJust Maybe [ProgramUnit a]
mSubs
          then forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Subprogram unit" FortranVersion
Fortran90
          else forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
fixedForm Doc -> Doc -> Doc
<>
               Indentation -> Doc -> Doc
indent Indentation
fixedForm (Doc
"end" Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise =
        Indentation -> Doc -> Doc
indent Indentation
i (Doc
"program" Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<?> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        Doc
newline Doc -> Doc -> Doc
<?>
        Indentation -> Doc -> Doc
indent Indentation
nextI (Doc
"contains" Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<?>
        Doc
newline Doc -> Doc -> Doc
<?>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v Maybe [ProgramUnit a]
mSubs Indentation
nextI Doc -> Doc -> Doc
<>
        Indentation -> Doc -> Doc
indent Indentation
i (Doc
"end" Doc -> Doc -> Doc
<> Doc
" program" Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<> Doc
newline)
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i

    pprint FortranVersion
v (PUModule a
_ SrcSpan
_ [Char]
name [Block a]
body Maybe [ProgramUnit a]
mSubs) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Indentation -> Doc -> Doc
indent Indentation
i (Doc
"module" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
name Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        Doc
newline Doc -> Doc -> Doc
<?>
        Indentation -> Doc -> Doc
indent Indentation
nextI (Doc
"contains" Doc -> Doc -> Doc
<?> Doc
newline) Doc -> Doc -> Doc
<?>
        Doc
newline Doc -> Doc -> Doc
<?>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v Maybe [ProgramUnit a]
mSubs Indentation
nextI Doc -> Doc -> Doc
<>
        Indentation -> Doc -> Doc
indent Indentation
i (Doc
"end module" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
name Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Module system" FortranVersion
Fortran90
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i

    pprint FortranVersion
v (PUSubroutine a
_ SrcSpan
_ (Prefixes a
mpfxs, Suffixes a
msfxs) [Char]
name Maybe (AList Expression a)
mArgs [Block a]
body Maybe [ProgramUnit a]
mSubs) Indentation
i =
        Indentation -> Doc -> Doc
indent Indentation
curI
          (Doc
prefix Doc -> Doc -> Doc
<+> Doc
"subroutine" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
name Doc -> Doc -> Doc
<>
          Doc
lparen Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mArgs Doc -> Doc -> Doc
<?> Doc
rparen Doc -> Doc -> Doc
<+> Doc
suffix Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        Doc
newline Doc -> Doc -> Doc
<?>
        Indentation -> Doc -> Doc
indent Indentation
nextI (Doc
"contains" Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<?>
        Doc
newline Doc -> Doc -> Doc
<?>
        Doc
subs  Doc -> Doc -> Doc
<>
        forall a.
Pretty a =>
FortranVersion -> Doc -> a -> Indentation -> Doc
endGen FortranVersion
v Doc
"subroutine" [Char]
name Indentation
curI
      where
        convPfx :: Prefix a -> Doc
convPfx (PfxElemental a
_ SrcSpan
_)
          | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95 = Doc
"elemental"
          | Bool
otherwise      = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Elemental function" FortranVersion
Fortran95
        convPfx (PfxPure a
_ SrcSpan
_)
          | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95 = Doc
"pure"
          | Bool
otherwise      = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Pure function" FortranVersion
Fortran95
        convPfx (PfxRecursive a
_ SrcSpan
_)
          | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"recursive"
          | Bool
otherwise      = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Recursive function" FortranVersion
Fortran90

        prefix :: Doc
prefix = [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map Prefix a -> Doc
convPfx [Prefix a]
pfxs)

        suffix :: Doc
suffix = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a. [a] -> Maybe a
listToMaybe [Suffix a]
sfxs)

        subs :: Doc
subs
          | forall a. Maybe a -> Bool
isJust Maybe [ProgramUnit a]
mSubs, FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v Maybe [ProgramUnit a]
mSubs Indentation
nextI
          | forall a. Maybe a -> Bool
isNothing Maybe [ProgramUnit a]
mSubs              = Doc
empty
          | Bool
otherwise                    = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Function subprogram" FortranVersion
Fortran90

        curI :: Indentation
curI = if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 then Indentation
i else Indentation
fixedForm
        nextI :: Indentation
nextI = if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 then Indentation -> Indentation
incIndentation Indentation
i
                                  else Indentation -> Indentation
incIndentation Indentation
fixedForm
        pfxs :: [Prefix a]
pfxs = forall (t :: * -> *) a. Maybe (AList t a) -> [t a]
aStrip' Prefixes a
mpfxs
        sfxs :: [Suffix a]
sfxs = forall (t :: * -> *) a. Maybe (AList t a) -> [t a]
aStrip' Suffixes a
msfxs

    pprint FortranVersion
v (PUFunction a
_ SrcSpan
_ Maybe (TypeSpec a)
mRetType (Prefixes a
mpfxs, Suffixes a
msfxs) [Char]
name Maybe (AList Expression a)
mArgs Maybe (Expression a)
mRes [Block a]
body Maybe [ProgramUnit a]
mSubs) Indentation
i =
        Indentation -> Doc -> Doc
indent Indentation
curI
          (Doc
prefix Doc -> Doc -> Doc
<+> Doc
"function" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
name Doc -> Doc -> Doc
<>
          Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mArgs) Doc -> Doc -> Doc
<+> Doc
suffix Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        Doc
newline Doc -> Doc -> Doc
<?>
        Indentation -> Doc -> Doc
indent Indentation
nextI (Doc
"contains" Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<?>
        Doc
newline Doc -> Doc -> Doc
<?>
        Doc
subs Doc -> Doc -> Doc
<>
        forall a.
Pretty a =>
FortranVersion -> Doc -> a -> Indentation -> Doc
endGen FortranVersion
v Doc
"function" [Char]
name Indentation
curI
      where
        convPfx :: Prefix a -> Doc
convPfx (PfxElemental a
_ SrcSpan
_)
          | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95 = Doc
"elemental"
          | Bool
otherwise      = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Elemental function" FortranVersion
Fortran95
        convPfx (PfxPure a
_ SrcSpan
_)
          | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95 = Doc
"pure"
          | Bool
otherwise      = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Pure function" FortranVersion
Fortran95
        convPfx (PfxRecursive a
_ SrcSpan
_)
          | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"recursive"
          | Bool
otherwise      = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Recursive function" FortranVersion
Fortran90

        prefix :: Doc
prefix = [Doc] -> Doc
hsep (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (TypeSpec a)
mRetTypeforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map Prefix a -> Doc
convPfx [Prefix a]
pfxs)

        result :: Doc
result
          | forall a. Maybe a -> Bool
isJust Maybe (Expression a)
mRes, FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"result" Doc -> Doc -> Doc
<?> Doc
lparen Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mRes Doc -> Doc -> Doc
<?> Doc
rparen
          | forall a. Maybe a -> Bool
isNothing Maybe (Expression a)
mRes              = Doc
empty
          | Bool
otherwise                   = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Function result" FortranVersion
Fortran90

        suffix :: Doc
suffix = Doc
result Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a. [a] -> Maybe a
listToMaybe [Suffix a]
sfxs)

        subs :: Doc
subs
          | forall a. Maybe a -> Bool
isJust Maybe [ProgramUnit a]
mSubs, FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v Maybe [ProgramUnit a]
mSubs Indentation
nextI
          | forall a. Maybe a -> Bool
isNothing Maybe [ProgramUnit a]
mSubs              = Doc
empty
          | Bool
otherwise                    = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Function subprogram" FortranVersion
Fortran90

        curI :: Indentation
curI = if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 then Indentation
i else Indentation
fixedForm
        nextI :: Indentation
nextI = if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 then Indentation -> Indentation
incIndentation Indentation
i
                                  else Indentation -> Indentation
incIndentation Indentation
fixedForm
        pfxs :: [Prefix a]
pfxs = forall (t :: * -> *) a. Maybe (AList t a) -> [t a]
aStrip' Prefixes a
mpfxs
        sfxs :: [Suffix a]
sfxs = forall (t :: * -> *) a. Maybe (AList t a) -> [t a]
aStrip' Suffixes a
msfxs

    pprint FortranVersion
v (PUBlockData a
_ SrcSpan
_ Maybe [Char]
mName [Block a]
body) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77, forall a. Maybe a -> Bool
isJust Maybe [Char]
mName = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Named block data" FortranVersion
Fortran77
      | Bool
otherwise =
        Indentation -> Doc -> Doc
indent Indentation
curI (Doc
"block data" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        forall a.
Pretty a =>
FortranVersion -> Doc -> a -> Indentation -> Doc
endGen FortranVersion
v Doc
"block data" Maybe [Char]
mName Indentation
curI
        where
          curI :: Indentation
curI = if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 then Indentation
i else Indentation
fixedForm
          nextI :: Indentation
nextI = if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90
                    then Indentation -> Indentation
incIndentation Indentation
i
                    else Indentation -> Indentation
incIndentation Indentation
fixedForm

    pprint FortranVersion
v (PUComment a
_ SrcSpan
_ (Comment [Char]
comment)) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Indentation -> Doc -> Doc
indent Indentation
i (Char -> Doc
char Char
'!' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
comment Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise = Char -> Doc
char Char
'c' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
comment Doc -> Doc -> Doc
<> Doc
newline

endGen :: Pretty a => FortranVersion -> Doc -> a -> Indentation -> Doc
endGen :: forall a.
Pretty a =>
FortranVersion -> Doc -> a -> Indentation -> Doc
endGen FortranVersion
v Doc
constructName a
name Indentation
i = Indentation -> Doc -> Doc
indent Indentation
i forall a b. (a -> b) -> a -> b
$ Doc
"end" Doc -> Doc -> Doc
<+> Doc
middle Doc -> Doc -> Doc
<> Doc
newline
  where
    middle :: Doc
middle
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77 = Doc
empty
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90 = Doc
constructName
      | Bool
otherwise = Doc
constructName Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v a
name

instance IndentablePretty [Block a] where
    pprint :: FortranVersion -> [Block a] -> Indentation -> Doc
pprint FortranVersion
v [Block a]
bs Indentation
i = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
b Block a
a -> Doc
b Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v Block a
a Indentation
i) Doc
empty [Block a]
bs

instance IndentablePretty (Block a) where
    pprint :: FortranVersion -> Block a -> Indentation -> Doc
pprint FortranVersion
v (BlForall a
_ SrcSpan
_ Maybe (Expression a)
mLabel Maybe [Char]
mName ForallHeader a
_ [Block a]
body Maybe (Expression a)
mel) Indentation
i =
      Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mLabel (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName) Doc -> Doc -> Doc
<> Doc
newline Doc -> Doc -> Doc
<>
      forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
      Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mel (Doc
"end forall" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<> Doc
newline)
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i
        labeledIndent :: Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
label Doc
stDoc =
          forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
label Doc -> Doc -> Doc
`overlay` Indentation -> Doc -> Doc
indent Indentation
i Doc
stDoc

    pprint FortranVersion
v (BlStatement a
_ SrcSpan
_ Maybe (Expression a)
mLabel Statement a
st) Indentation
i =
      if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90
        then Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Statement a
st Doc -> Doc -> Doc
<> Doc
newline)
        else forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
`overlay` Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Statement a
st Doc -> Doc -> Doc
<> Doc
newline)

    pprint FortranVersion
v (BlIf a
_ SrcSpan
_ Maybe (Expression a)
mLabel Maybe [Char]
mName ((Expression a
ifPred, [Block a]
thenBlock) :| [(Expression a, [Block a])]
elseIfs) Maybe [Block a]
mElseBlock Maybe (Expression a)
el) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 =
               Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mLabel Doc
displayIfThen
            Doc -> Doc -> Doc
<> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc -> Doc -> Doc
(<>) Doc
empty (forall a b. (a -> b) -> [a] -> [b]
map (Expression a, [Block a]) -> Doc
displayElseIf [(Expression a, [Block a])]
elseIfs)
            Doc -> Doc -> Doc
<> forall a. (a -> Doc) -> Maybe a -> Doc
printMaybe [Block a] -> Doc
displayElse Maybe [Block a]
mElseBlock
            Doc -> Doc -> Doc
<> Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
el (Doc
"end if" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName)
            Doc -> Doc -> Doc
<> Doc
newline
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Structured if" FortranVersion
Fortran77
      where
        displayIfThen :: Doc
displayIfThen =
            Doc -> [Block a] -> Doc
displayClause Doc
displayIfPred [Block a]
thenBlock
        displayIfPred :: Doc
displayIfPred =
            forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Expression a -> Doc
displayPred Doc
"if" Expression a
ifPred
        displayPred :: Doc -> Expression a -> Doc
displayPred Doc
str Expression a
pred =
            Indentation -> Doc -> Doc
indent Indentation
i Doc
str Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
pred) Doc -> Doc -> Doc
<+> Doc
"then"
        displayElseIf :: (Expression a, [Block a]) -> Doc
displayElseIf (Expression a
pred, [Block a]
block) =
            Doc -> [Block a] -> Doc
displayClause (Doc -> Expression a -> Doc
displayPred Doc
"else if" Expression a
pred) [Block a]
block
        displayElse :: [Block a] -> Doc
displayElse [Block a]
block =
            Doc -> [Block a] -> Doc
displayClause (Indentation -> Doc -> Doc
indent Indentation
i Doc
"else") [Block a]
block
        displayClause :: Doc -> [Block a] -> Doc
displayClause = forall a. FortranVersion -> Indentation -> Doc -> [Block a] -> Doc
printIndentedBlockWithPre FortranVersion
v Indentation
i
        labeledIndent :: Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
label Doc
stDoc =
          if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90
            then Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
label Doc -> Doc -> Doc
<+> Doc
stDoc)
            else forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
`overlay` Indentation -> Doc -> Doc
indent Indentation
i Doc
stDoc

    pprint FortranVersion
v (BlCase a
_ SrcSpan
_ Maybe (Expression a)
mLabel Maybe [Char]
mName Expression a
scrutinee [(AList Index a, [Block a])]
clauses Maybe [Block a]
mDefaultCase Maybe (Expression a)
el) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
             Indentation -> Doc -> Doc
indent Indentation
i (Doc
pre Doc -> Doc -> Doc
<+> Doc
"select case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
scrutinee))
          Doc -> Doc -> Doc
<> Doc
newline
          Doc -> Doc -> Doc
<> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc -> Doc -> Doc
(<>) Doc
empty (forall a b. (a -> b) -> [a] -> [b]
map (AList Index a, [Block a]) -> Doc
displayCase [(AList Index a, [Block a])]
clauses)
          Doc -> Doc -> Doc
<> forall a. (a -> Doc) -> Maybe a -> Doc
printMaybe [Block a] -> Doc
displayCaseDefault Maybe [Block a]
mDefaultCase
          Doc -> Doc -> Doc
<> Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
el Doc -> Doc -> Doc
<+> Doc
"end select" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName)
          Doc -> Doc -> Doc
<> Doc
newline
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Select case" FortranVersion
Fortran90
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i
        pre :: Doc
pre = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<?> Doc
colon
        displayCaseDefault :: [Block a] -> Doc
displayCaseDefault =
            Doc -> [Block a] -> Doc
displayClause (Indentation -> Doc -> Doc
indent Indentation
nextI Doc
"case default")
        displayCase :: (AList Index a, [Block a]) -> Doc
displayCase (AList Index a
ranges, [Block a]
block) =
            Doc -> [Block a] -> Doc
displayClause (Indentation -> Doc -> Doc
indent Indentation
nextI forall a b. (a -> b) -> a -> b
$ Doc
"case" Doc -> Doc -> Doc
<+> AList Index a -> Doc
displayRanges AList Index a
ranges) [Block a]
block
        displayRanges :: AList Index a -> Doc
displayRanges = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v
        displayClause :: Doc -> [Block a] -> Doc
displayClause = forall a. FortranVersion -> Indentation -> Doc -> [Block a] -> Doc
printIndentedBlockWithPre FortranVersion
v Indentation
nextI

    pprint FortranVersion
v (BlInterface a
_ SrcSpan
_ Maybe (Expression a)
mLabel Bool
abstractp [ProgramUnit a]
pus [Block a]
moduleProcs) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Indentation -> Doc -> Doc
indent Indentation
i (Doc
abstract Doc -> Doc -> Doc
<>  Doc
"interface" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [ProgramUnit a]
pus Indentation
nextI Doc -> Doc -> Doc
<>
        Doc
newline Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
moduleProcs Indentation
nextI Doc -> Doc -> Doc
<>
        Indentation -> Doc -> Doc
indent Indentation
i (Doc
"end interface" Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Interface" FortranVersion
Fortran90
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i
        abstract :: Doc
abstract | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 Bool -> Bool -> Bool
&& Bool
abstractp = Doc
"abstract "
                 | Bool
otherwise = Doc
empty

    pprint FortranVersion
v (BlDo a
_ SrcSpan
_ Maybe (Expression a)
mLabel Maybe [Char]
mn Maybe (Expression a)
tl Maybe (DoSpecification a)
doSpec [Block a]
body Maybe (Expression a)
el) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77Extended =
        Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mLabel
          (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mn Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<+>
          Doc
"do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
tl Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (DoSpecification a)
doSpec Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        if forall a. Maybe a -> Bool
isJust Maybe (Expression a)
tl Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe [Char]
mn
          then Doc
empty
          else Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
el (Doc
"end do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mn Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise =
        case Maybe (Expression a)
tl of
          Just Expression a
tLabel ->
            Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mLabel
              (Doc
"do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
tLabel Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (DoSpecification a)
doSpec Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
            forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI
          Maybe (Expression a)
Nothing ->
            forall a. [Char] -> a
prettyError [Char]
"Fortran 77 and earlier versions only have labeled DO blocks"
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i
        labeledIndent :: Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
label Doc
stDoc =
          if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90
            then Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
label Doc -> Doc -> Doc
<+> Doc
stDoc)
            else forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
`overlay` Indentation -> Doc -> Doc
indent Indentation
i Doc
stDoc

    pprint FortranVersion
v (BlDoWhile a
_ SrcSpan
_ Maybe (Expression a)
mLabel Maybe [Char]
mName Maybe (Expression a)
mTarget Expression a
cond [Block a]
body Maybe (Expression a)
el) Indentation
i
       | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77Extended =
        Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mLabel
          (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<+>
          Doc
"do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mTarget Doc -> Doc -> Doc
<+> Doc
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
cond) Doc -> Doc -> Doc
<> Doc
newline) Doc -> Doc -> Doc
<>
        forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
body Indentation
nextI Doc -> Doc -> Doc
<>
        if forall a. Maybe a -> Bool
isJust Maybe (Expression a)
mTarget Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe [Char]
mName
          then Doc
empty
          else Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
el (Doc
"end do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Do while loop" FortranVersion
Fortran77Extended
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i
        labeledIndent :: Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
label Doc
stDoc =
          if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90
            then Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
label Doc -> Doc -> Doc
<+> Doc
stDoc)
            else forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
`overlay` Indentation -> Doc -> Doc
indent Indentation
i Doc
stDoc

    -- Note that binary expressions such as @a*b@ will always be wrapped in
    -- brackets. It appears to be built into 'Expression''s 'Pretty' instance.
    pprint FortranVersion
v (BlAssociate a
_ SrcSpan
_ Maybe (Expression a)
mLabel Maybe [Char]
mName AList (ATuple Expression Expression) a
abbrevs [Block a]
bodies Maybe (Expression a)
mEndLabel) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 =
        Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mLabel
          forall a b. (a -> b) -> a -> b
$  forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<?> Doc
colon
                Doc -> Doc -> Doc
<+> (Doc
"associate" Doc -> Doc -> Doc
<+> Doc
"(" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList (ATuple Expression Expression) a
abbrevs Doc -> Doc -> Doc
<> Doc
")" Doc -> Doc -> Doc
<> Doc
newline)
          Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v [Block a]
bodies Indentation
nextI
          Doc -> Doc -> Doc
<> Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
mEndLabel (Doc
"end associate" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Associate block" FortranVersion
Fortran2003
      where
        nextI :: Indentation
nextI = Indentation -> Indentation
incIndentation Indentation
i
        labeledIndent :: Maybe (Expression a) -> Doc -> Doc
labeledIndent Maybe (Expression a)
label Doc
stDoc =
          if FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90
            then Indentation -> Doc -> Doc
indent Indentation
i (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
label Doc -> Doc -> Doc
<+> Doc
stDoc)
            else forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
`overlay` Indentation -> Doc -> Doc
indent Indentation
i Doc
stDoc

    pprint FortranVersion
v (BlComment a
_ SrcSpan
_ (Comment [Char]
comment)) Indentation
i
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Indentation -> Doc -> Doc
indent Indentation
i (Char -> Doc
char Char
'!' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
comment Doc -> Doc -> Doc
<> Doc
newline)
      | Bool
otherwise = Char -> Doc
char Char
'c' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
comment Doc -> Doc -> Doc
<> Doc
newline

class Pretty t where
    pprint' :: FortranVersion -> t -> Doc

instance Pretty a => Pretty (Maybe a) where
    pprint' :: FortranVersion -> Maybe a -> Doc
pprint' FortranVersion
_ Maybe a
Nothing  = Doc
empty
    pprint' FortranVersion
v (Just a
e) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v a
e

instance Pretty String where
    pprint' :: FortranVersion -> [Char] -> Doc
pprint' FortranVersion
_ = [Char] -> Doc
text

instance Pretty (e a) => Pretty (AList e a) where
    pprint' :: FortranVersion -> AList e a -> Doc
pprint' FortranVersion
v AList e a
es = [Doc] -> Doc
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList e a
es))

instance (Pretty (t1 a), Pretty (t2 a)) => Pretty (ATuple t1 t2 a) where
    pprint' :: FortranVersion -> ATuple t1 t2 a -> Doc
pprint' FortranVersion
v (ATuple a
_ SrcSpan
_ t1 a
t1 t2 a
t2) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v t1 a
t1 Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v t2 a
t2

instance Pretty BaseType where
    pprint' :: FortranVersion -> BaseType -> Doc
pprint' FortranVersion
_ BaseType
TypeInteger = Doc
"integer"
    pprint' FortranVersion
_ BaseType
TypeReal    = Doc
"real"
    pprint' FortranVersion
_ BaseType
TypeDoublePrecision = Doc
"double precision"
    pprint' FortranVersion
_ BaseType
TypeComplex = Doc
"complex"
    pprint' FortranVersion
v BaseType
TypeDoubleComplex
      | FortranVersion
v forall a. Eq a => a -> a -> Bool
== FortranVersion
Fortran77Extended = Doc
"double complex"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Double complex" FortranVersion
Fortran77Extended
    pprint' FortranVersion
_ BaseType
TypeLogical = Doc
"logical"
    pprint' FortranVersion
v BaseType
TypeCharacter
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 = Doc
"character"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Character data type" FortranVersion
Fortran77
    pprint' FortranVersion
v (TypeCustom [Char]
str)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"type" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Char] -> Doc
text [Char]
str)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77Extended = Doc
"record" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
str Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/'
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"User defined type" FortranVersion
Fortran90
    pprint' FortranVersion
v BaseType
TypeByte
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77Extended = Doc
"byte"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Byte" FortranVersion
Fortran77Extended
    pprint' FortranVersion
v BaseType
ClassStar
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"class(*)"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Class(*)" FortranVersion
Fortran2003
    pprint' FortranVersion
v (ClassCustom [Char]
str)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"class" Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Char] -> Doc
text [Char]
str)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Class(spec)" FortranVersion
Fortran2003

instance Pretty (TypeSpec a) where
    pprint' :: FortranVersion -> TypeSpec a -> Doc
pprint' FortranVersion
v (TypeSpec a
_ SrcSpan
_ BaseType
baseType Maybe (Selector a)
mSelector) =
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v BaseType
baseType Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Selector a)
mSelector

-- | Note that this instance is tightly bound with 'TypeSpec' due to 'Selector'
--   appending information on where 'TypeSpec' should have been prettied. By
--   itself, this instance is less sensible.
instance Pretty (Selector a) where
  pprint' :: FortranVersion -> Selector a -> Doc
pprint' FortranVersion
v (Selector a
_ SrcSpan
_ Maybe (Expression a)
mLenSel Maybe (Expression a)
mKindSel)
    | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77 = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Length/kind selector" FortranVersion
Fortran77
    | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90 =
      case (Maybe (Expression a)
mLenSel, Maybe (Expression a)
mKindSel) of
        (Just Expression a
lenSel, Maybe (Expression a)
Nothing) ->
          Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<> forall a. FortranVersion -> Expression a -> Doc
noParensLit FortranVersion
v Expression a
lenSel
        (Maybe (Expression a)
Nothing, Just Expression a
kindSel) ->
          Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<> forall a. FortranVersion -> Expression a -> Doc
noParensLit FortranVersion
v Expression a
kindSel
        (Just{} , Just{}) ->
          forall a. [Char] -> a
prettyError [Char]
"Kind and length selectors can be active one at a time in\
                      \Fortran 77."
        (Maybe (Expression a)
Nothing, Maybe (Expression a)
Nothing) ->
          forall a. [Char] -> a
prettyError [Char]
"empty selector disallowed"

    | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
      case (Maybe (Expression a)
mLenSel, Maybe (Expression a)
mKindSel) of
        (Just Expression a
lenSel, Just Expression a
kindSel) ->
          Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ Expression a -> Doc
len Expression a
lenSel Doc -> Doc -> Doc
<> Char -> Doc
char Char
',' Doc -> Doc -> Doc
<+> Expression a -> Doc
kind Expression a
kindSel
        (Maybe (Expression a)
Nothing, Just Expression a
kindSel) -> Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ Expression a -> Doc
kind Expression a
kindSel
        (Just Expression a
lenDev, Maybe (Expression a)
Nothing) -> Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ Expression a -> Doc
len Expression a
lenDev
        (Maybe (Expression a)
Nothing, Maybe (Expression a)
Nothing) ->
          forall a. [Char] -> a
prettyError [Char]
"No way for both kind and length selectors to be empty in\
                \Fortran 90 onwards."
    | Bool
otherwise = forall a. [Char] -> a
prettyError [Char]
"unhandled version"
    where
      len :: Expression a -> Doc
len Expression a
e  = Doc
"len=" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
      kind :: Expression a -> Doc
kind Expression a
e = Doc
"kind=" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e

-- | Pretty print an 'Expression' inside parentheses, _except_ if the
--   'Expression' is an integer literal, in which case print without the parens.
noParensLit :: FortranVersion -> Expression a -> Doc
noParensLit :: forall a. FortranVersion -> Expression a -> Doc
noParensLit FortranVersion
v Expression a
e = case Expression a
e of ExpValue a
_ SrcSpan
_ ValInteger{} ->          forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
                            Expression a
_                         -> Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e

instance Pretty (Statement a) where
    pprint' :: FortranVersion -> Statement a -> Doc
pprint' FortranVersion
v (StDeclaration a
_ SrcSpan
_ TypeSpec a
typeSpec Maybe (AList Attribute a)
mAttrList AList Declarator a
declList)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90 = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v TypeSpec a
typeSpec Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
declList
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
          forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v TypeSpec a
typeSpec Doc -> Doc -> Doc
<>
          (if forall a. Maybe a -> Bool
isJust Maybe (AList Attribute a)
mAttrList then Doc
comma else Doc
empty) Doc -> Doc -> Doc
<+>
          forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Attribute a)
mAttrList Doc -> Doc -> Doc
<+>
          [Char] -> Doc
text [Char]
"::" Doc -> Doc -> Doc
<+>
          forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
declList
      | Bool
otherwise = forall a. [Char] -> a
prettyError [Char]
"unhandled version"

    pprint' FortranVersion
v (StStructure a
_ SrcSpan
_ Maybe [Char]
mName AList StructureItem a
itemList) =
        forall a. FortranVersion -> [Char] -> FortranVersion -> a -> a
olderThan FortranVersion
Fortran77Legacy [Char]
"Structure" FortranVersion
v forall a b. (a -> b) -> a -> b
$
          Doc
"structure"
          Doc -> Doc -> Doc
<+> (if forall a. Maybe a -> Bool
isJust Maybe [Char]
mName then Doc
"/" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mName Doc -> Doc -> Doc
<> Doc
"/" else Doc
empty)
          Doc -> Doc -> Doc
<> Doc
newline
          Doc -> Doc -> Doc
<> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
doc StructureItem a
item -> Doc
doc Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v StructureItem a
item (Indentation -> Indentation
incIndentation (forall a. a -> Maybe a
Just Int
0)) Doc -> Doc -> Doc
<> Doc
newline) Doc
empty (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList StructureItem a
itemList)
          Doc -> Doc -> Doc
<> Doc
"end structure"

    pprint' FortranVersion
v (StIntent a
_ SrcSpan
_ Intent
intent AList Expression a
exps)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
          Doc
"intent" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Intent
intent) Doc -> Doc -> Doc
<+> Doc
"::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
exps
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Intent statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StOptional a
_ SrcSpan
_ AList Expression a
vars)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"optional ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Optional statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StPublic a
_ SrcSpan
_ Maybe (AList Expression a)
mVars)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"public" Doc -> Doc -> Doc
<> Doc
" :: " Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mVars
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Public statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StPrivate a
_ SrcSpan
_ Maybe (AList Expression a)
mVars)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"private" Doc -> Doc -> Doc
<> Doc
" :: " Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mVars
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Private statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StProtected a
_ SrcSpan
_ Maybe (AList Expression a)
mVars)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"protected" Doc -> Doc -> Doc
<> Doc
" :: " Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mVars
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Protected statement" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StSave a
_ SrcSpan
_ Maybe (AList Expression a)
mVars)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"save" Doc -> Doc -> Doc
<> Doc
" :: " Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mVars
      | Bool
otherwise = Doc
"save" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mVars

    pprint' FortranVersion
v (StDimension a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"dimension ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = Doc
"dimension" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls

    pprint' FortranVersion
v (StAllocatable a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"allocatable ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Allocatable statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StAsynchronous a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"asynchronous ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Asynchronous statement" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StPointer a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"pointer ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Pointer statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StTarget a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"target ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Target statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StValue a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95 = Doc
"value ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Value statement" FortranVersion
Fortran95

    pprint' FortranVersion
v (StVolatile a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95 = Doc
"volatile ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Volatile statement" FortranVersion
Fortran95

    pprint' FortranVersion
v (StData a
_ SrcSpan
_ aDataGroups :: AList DataGroup a
aDataGroups@(AList a
_ SrcSpan
_ [DataGroup a]
dataGroups))
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"data" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList DataGroup a
aDataGroups
      | Bool
otherwise = Doc
"data" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) [DataGroup a]
dataGroups)

    pprint' FortranVersion
v (StAutomatic a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Eq a => a -> a -> Bool
== FortranVersion
Fortran77Extended = Doc
"automatic" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Automatic statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StStatic a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Eq a => a -> a -> Bool
== FortranVersion
Fortran77Extended = Doc
"static" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Static statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StNamelist a
_ SrcSpan
_ AList Namelist a
namelist)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"namelist" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Namelist a
namelist
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Namelist statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StParameter a
_ SrcSpan
_ AList Declarator a
aDecls) = Doc
"parameter" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
aDecls)

    pprint' FortranVersion
v (StExternal a
_ SrcSpan
_ AList Expression a
vars) = Doc
"external" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars
    pprint' FortranVersion
v (StIntrinsic a
_ SrcSpan
_ AList Expression a
vars) = Doc
"intrinsic" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars

    pprint' FortranVersion
v (StCommon a
_ SrcSpan
_ AList CommonGroup a
aCommonGroups) = Doc
"common" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList CommonGroup a
aCommonGroups

    pprint' FortranVersion
v (StEquivalence a
_ SrcSpan
_ (AList a
_ SrcSpan
_ [AList Expression a]
equivGroups)) =
      Doc
"equivalence" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) [AList Expression a]
equivGroups)

    pprint' FortranVersion
v (StFormat a
_ SrcSpan
_ (AList a
_ SrcSpan
_ [FormatItem a]
formatItems)) =
      Doc
"format" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) [FormatItem a]
formatItems)

    pprint' FortranVersion
v (StImplicit a
_ SrcSpan
_ Maybe (AList ImpList a)
mImpLists)
      | Just AList ImpList a
impLists <- Maybe (AList ImpList a)
mImpLists = Doc
"implicit" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ImpList a
impLists
      | Bool
otherwise = Doc
"implicit none"

    pprint' FortranVersion
v (StEntry a
_ SrcSpan
_ Expression a
name Maybe (AList Expression a)
mArgs Maybe (Expression a)
mResult)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90 =
        case Maybe (Expression a)
mResult of
          Maybe (Expression a)
Nothing ->
            Doc
"entry" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
name Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mArgs)
          Just Expression a
_ -> forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Explicit result" FortranVersion
Fortran90
      | Bool
otherwise =
        Doc
"entry" Doc -> Doc -> Doc
<+>
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
name Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mArgs) Doc -> Doc -> Doc
<+>
        Doc
"result (" Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mResult Doc -> Doc -> Doc
<?> Char -> Doc
char Char
')'

    pprint' FortranVersion
v (StInclude a
_ SrcSpan
_ Expression a
file Maybe [Block a]
_) = Doc
"include" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
file

    pprint' FortranVersion
v (StDo a
_ SrcSpan
_ Maybe [Char]
mConstructor Maybe (Expression a)
mLabel Maybe (DoSpecification a)
mDoSpec)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90
      , Just [Char]
_ <- Maybe [Char]
mConstructor = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Named DO block" FortranVersion
Fortran90
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77Extended
      , Maybe (Expression a)
Nothing <- Maybe (Expression a)
mLabel = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Labelless DO block" FortranVersion
Fortran90
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90
      , Maybe (DoSpecification a)
Nothing <- Maybe (DoSpecification a)
mDoSpec = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Infinite DO loop" FortranVersion
Fortran90
      | Bool
otherwise =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<+>
        Doc
"do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (DoSpecification a)
mDoSpec

    pprint' FortranVersion
v (StDoWhile a
_ SrcSpan
_ Maybe [Char]
mConstructor Maybe (Expression a)
mLabel Expression a
pred)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77Extended = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"While loop" FortranVersion
Fortran77Extended
      | Bool
otherwise =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<+>
        Doc
"do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mLabel Doc -> Doc -> Doc
<+>
        Doc
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
pred)

    pprint' FortranVersion
v (StEnddo a
_ SrcSpan
_ Maybe [Char]
mConstructor)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77Extended = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"End do" FortranVersion
Fortran77Extended
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90
      , Maybe [Char]
_ <- Maybe [Char]
mConstructor = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Named DO loop" FortranVersion
Fortran90
      | Bool
otherwise = Doc
"end do" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor

    pprint' FortranVersion
v (StExpressionAssign a
_ SrcSpan
_ Expression a
lhs Expression a
rhs) =
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
lhs Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
rhs

    pprint' FortranVersion
v (StCycle a
_ SrcSpan
_ Maybe (Expression a)
mConstructor)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"cycle" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mConstructor
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Cycle" FortranVersion
Fortran90

    pprint' FortranVersion
v (StExit a
_ SrcSpan
_ Maybe (Expression a)
mConstructor)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77Extended = Doc
"exit" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mConstructor
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Exit" FortranVersion
Fortran77Extended

    pprint' FortranVersion
v (StIfLogical a
_ SrcSpan
_ Expression a
pred Statement a
st) =
      Doc
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
pred) Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Statement a
st

    pprint' FortranVersion
v (StIfArithmetic a
_ SrcSpan
_ Expression a
exp Expression a
ltPred Expression a
eqPred Expression a
gtPred) =
      Doc
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
exp) Doc -> Doc -> Doc
<+>
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
ltPred Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+>
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
eqPred Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+>
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
gtPred

    pprint' FortranVersion
v (StSelectCase a
_ SrcSpan
_ Maybe [Char]
mConstructor Expression a
exp)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<+>
        Doc
"select case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
exp)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Case statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StCase a
_ SrcSpan
_ Maybe [Char]
mConstructor Maybe (AList Index a)
mCase)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        case Maybe (AList Index a)
mCase of
          Just AList Index a
casee ->
            Doc
"case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Index a
casee) Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor
          Maybe (AList Index a)
Nothing -> Doc
"case default" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Case statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StEndcase a
_ SrcSpan
_ Maybe [Char]
mConstructor)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"end case" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
mConstructor
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Case statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StFunction a
_ SrcSpan
_ Expression a
name AList Expression a
args Expression a
rhs) =
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
name Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
args) Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
rhs

    pprint' FortranVersion
v (StPointerAssign a
_ SrcSpan
_ Expression a
lhs Expression a
rhs)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
lhs Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
rhs
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Pointer assignment" FortranVersion
Fortran90

    pprint' FortranVersion
v (StLabelAssign a
_ SrcSpan
_ Expression a
label Expression a
binding) =
      Doc
"assign" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
label Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
binding

    pprint' FortranVersion
v (StGotoUnconditional a
_ SrcSpan
_ Expression a
label) = Doc
"goto" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
label
    pprint' FortranVersion
v (StGotoAssigned a
_ SrcSpan
_ Expression a
target Maybe (AList Expression a)
labels) =
      Doc
"goto" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
target Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
labels)
    pprint' FortranVersion
v (StGotoComputed a
_ SrcSpan
_ AList Expression a
labels Expression a
target) =
      Doc
"goto" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
labels) Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
target

    pprint' FortranVersion
v (StCall a
_ SrcSpan
_ Expression a
name AList Argument a
args) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
name Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Argument a
args)

    pprint' FortranVersion
_ (StContinue a
_ SrcSpan
_) = Doc
"continue"

    pprint' FortranVersion
v (StReturn a
_ SrcSpan
_ Maybe (Expression a)
exp) = Doc
"return" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
exp

    pprint' FortranVersion
v (StStop a
_ SrcSpan
_ Maybe (Expression a)
code) = Doc
"stop" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
code

    pprint' FortranVersion
v (StPause a
_ SrcSpan
_ Maybe (Expression a)
code) = Doc
"pause" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
code

    pprint' FortranVersion
v (StRead a
_ SrcSpan
_ AList ControlPair a
cilist Maybe (AList Expression a)
mIolist) =
      Doc
"read" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist) Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mIolist
    pprint' FortranVersion
v (StRead2 a
_ SrcSpan
_ Expression a
formatId Maybe (AList Expression a)
mIolist) =
      Doc
"read" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
formatId Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mIolist

    pprint' FortranVersion
v (StWrite a
_ SrcSpan
_ AList ControlPair a
cilist Maybe (AList Expression a)
mIolist) =
      Doc
"write" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist) Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mIolist
    pprint' FortranVersion
v (StPrint a
_ SrcSpan
_ Expression a
formatId Maybe (AList Expression a)
mIolist) =
      Doc
"print" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
formatId Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mIolist
    pprint' FortranVersion
v (StTypePrint a
_ SrcSpan
_ Expression a
formatId Maybe (AList Expression a)
mIolist)
      | FortranVersion
v forall a. Eq a => a -> a -> Bool
== FortranVersion
Fortran77Extended
      = Doc
"type" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
formatId Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Expression a)
mIolist
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Type (print) statement" FortranVersion
Fortran77Extended

    pprint' FortranVersion
v (StOpen a
_ SrcSpan
_ AList ControlPair a
cilist) = Doc
"open" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist)
    pprint' FortranVersion
v (StClose a
_ SrcSpan
_ AList ControlPair a
cilist) = Doc
"close" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist)
    pprint' FortranVersion
v (StFlush a
_ SrcSpan
_ (AList a
_ SrcSpan
_ [FlushSpec a]
fslist))
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"flush" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
commaSep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) [FlushSpec a]
fslist)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Flush statement" FortranVersion
Fortran2003
    pprint' FortranVersion
v (StInquire a
_ SrcSpan
_ AList ControlPair a
cilist) = Doc
"inquire" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist)

    pprint' FortranVersion
v (StRewind a
_ SrcSpan
_ AList ControlPair a
cilist) = Doc
"rewind" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist)
    pprint' FortranVersion
v (StRewind2 a
_ SrcSpan
_ Expression a
unit) = Doc
"rewind" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
unit

    pprint' FortranVersion
v (StBackspace a
_ SrcSpan
_ AList ControlPair a
cilist) =
      Doc
"backspace" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist)
    pprint' FortranVersion
v (StBackspace2 a
_ SrcSpan
_ Expression a
unit) = Doc
"backspace" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
unit

    pprint' FortranVersion
v (StEndfile a
_ SrcSpan
_ AList ControlPair a
cilist) = Doc
"endfile" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ControlPair a
cilist)
    pprint' FortranVersion
v (StEndfile2 a
_ SrcSpan
_ Expression a
unit) = Doc
"endfile" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
unit

    pprint' FortranVersion
v (StAllocate a
_ SrcSpan
_ (Just TypeSpec a
ty) AList Expression a
vars Maybe (AList AllocOpt a)
opts)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 =
        Doc
"allocate" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v TypeSpec a
ty Doc -> Doc -> Doc
<+> Doc
"::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList AllocOpt a)
opts)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Allocate with type_spec" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StAllocate a
_ SrcSpan
_ Maybe (TypeSpec a)
Nothing AList Expression a
vars Maybe (AList AllocOpt a)
opts)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Doc
"allocate" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList AllocOpt a)
opts)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Allocate" FortranVersion
Fortran90

    pprint' FortranVersion
v (StDeallocate a
_ SrcSpan
_ AList Expression a
vars Maybe (AList AllocOpt a)
opts)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Doc
"deallocate" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList AllocOpt a)
opts)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Deallocate" FortranVersion
Fortran90

    pprint' FortranVersion
v (StNullify a
_ SrcSpan
_ AList Expression a
vars) = Doc
"nullify" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars

    pprint' FortranVersion
v (StWhere a
_ SrcSpan
_ Expression a
mask Statement a
assignment)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Doc
"where" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
mask) Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Statement a
assignment
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Where statement" FortranVersion
Fortran90

    pprint' FortranVersion
v (StWhereConstruct a
_ SrcSpan
_ (Just [Char]
lab) Expression a
mask)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = [Char] -> Doc
text [Char]
lab Doc -> Doc -> Doc
<> Doc
":" Doc -> Doc -> Doc
<+> Doc
"where" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
mask)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Labelled where construct" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StWhereConstruct a
_ SrcSpan
_ Maybe [Char]
Nothing Expression a
mask)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"where" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
mask)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Where construct" FortranVersion
Fortran90

    pprint' FortranVersion
v (StElsewhere a
_ SrcSpan
_ (Just [Char]
lab) Maybe (Expression a)
mexp)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"else where" Doc -> Doc -> Doc
<+> Doc
"(" Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mexp Doc -> Doc -> Doc
<?> Doc
")" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
lab
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Labelled ELSEWHERE" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StElsewhere a
_ SrcSpan
_ Maybe [Char]
Nothing Maybe (Expression a)
mexp)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"else where" Doc -> Doc -> Doc
<+> Doc
"(" Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mexp Doc -> Doc -> Doc
<?> Doc
")"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Else where" FortranVersion
Fortran90

    pprint' FortranVersion
v (StEndWhere a
_ SrcSpan
_ (Just [Char]
lab))
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"end where" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
lab
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Labelled END WHERE" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StEndWhere a
_ SrcSpan
_ Maybe [Char]
Nothing)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"end where"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"End where" FortranVersion
Fortran90

    pprint' FortranVersion
v (StUse a
_ SrcSpan
_ Expression a
moduleName Maybe ModuleNature
mIntrinsic Only
only Maybe (AList Use a)
mappings)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 =
        Doc
"use" Doc -> Doc -> Doc
<> (Doc
comma Doc -> Doc -> Doc
<?+> Doc
intrinsic Doc -> Doc -> Doc
<?+> Doc
"::") Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
moduleName Doc -> Doc -> Doc
<>
        (Doc
comma Doc -> Doc -> Doc
<?+> (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Only
only Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Use a)
mappings))
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Doc
"use" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
moduleName Doc -> Doc -> Doc
<>
        (Doc
comma Doc -> Doc -> Doc
<?+> (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Only
only Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Use a)
mappings))
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Module system" FortranVersion
Fortran90
      where
        intrinsic :: Doc
intrinsic = case Maybe ModuleNature
mIntrinsic of
          Just ModuleNature
ModIntrinsic    -> Doc
"intrinsic"
          Just ModuleNature
ModNonIntrinsic -> Doc
"non_intrinsic"
          Maybe ModuleNature
Nothing              -> Doc
empty

    pprint' FortranVersion
v (StModuleProcedure a
_ SrcSpan
_ AList Expression a
procedures)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        Doc
"module procedure" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
procedures
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Module procedure" FortranVersion
Fortran90

    pprint' FortranVersion
v (StProcedure a
_ SrcSpan
_ Maybe (ProcInterface a)
mProcInterface Maybe (AList Attribute a)
mSuffix (AList a
_ SrcSpan
_ [ProcDecl a]
procDecls))
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 =
        Doc
"procedure" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (ProcInterface a)
mProcInterface) Doc -> Doc -> Doc
<>
        Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Attribute a)
mSuffix Doc -> Doc -> Doc
<+> Doc
"::" Doc -> Doc -> Doc
<?+>
        [Doc] -> Doc
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) [ProcDecl a]
procDecls)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Procedure" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StType a
_ SrcSpan
_ Maybe (AList Attribute a)
attrs [Char]
name)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"type" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (AList Attribute a)
attrs Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v [Char]
name
      | Bool
otherwise  = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Derived type" FortranVersion
Fortran90

    pprint' FortranVersion
v (StEndType a
_ SrcSpan
_ Maybe [Char]
name)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"end type" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe [Char]
name
      | Bool
otherwise  = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Derived type" FortranVersion
Fortran90

    pprint' FortranVersion
v (StEnum a
_ SrcSpan
_)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"enum, bind(c)"
      | Bool
otherwise  = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Enum" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StEnumerator a
_ SrcSpan
_ AList Declarator a
decls)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"enumerator ::" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
decls
      | Bool
otherwise  = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Enumator" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StEndEnum a
_ SrcSpan
_)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"end enum"
      | Bool
otherwise  = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"End enum" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StSequence a
_ SrcSpan
_)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"sequence"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Sequence" FortranVersion
Fortran90

    pprint' FortranVersion
v (StImport a
_ SrcSpan
_ (AList a
_ SrcSpan
_ [Expression a]
vs))
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"import" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v) [Expression a]
vs)
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Import" FortranVersion
Fortran2003

    pprint' FortranVersion
v (StFormatBogus a
_ SrcSpan
_ [Char]
blob) = Doc
"format" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v [Char]
blob
    pprint' FortranVersion
_ StForall{} = forall a. [Char] -> a
prettyError [Char]
"unhandled pprint StForall"
    pprint' FortranVersion
_ StForallStatement{} = forall a. [Char] -> a
prettyError [Char]
"unhandled pprint StForallStatement"
    pprint' FortranVersion
_ StEndForall{} = forall a. [Char] -> a
prettyError [Char]
"unhandled pprint StEndForall"

instance Pretty (ProcInterface a) where
  pprint' :: FortranVersion -> ProcInterface a -> Doc
pprint' FortranVersion
v (ProcInterfaceName a
_ SrcSpan
_ Expression a
e) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
  pprint' FortranVersion
v (ProcInterfaceType a
_ SrcSpan
_ TypeSpec a
t) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v TypeSpec a
t

instance Pretty (ProcDecl a) where
  pprint' :: FortranVersion -> ProcDecl a -> Doc
pprint' FortranVersion
v (ProcDecl a
_ SrcSpan
_ Expression a
e1 (Just Expression a
e2)) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e1 Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e2
  pprint' FortranVersion
v (ProcDecl a
_ SrcSpan
_ Expression a
e1 Maybe (Expression a)
Nothing)   = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e1

instance Pretty Only where
    pprint' :: FortranVersion -> Only -> Doc
pprint' FortranVersion
_ Only
Exclusive = Doc
"only" Doc -> Doc -> Doc
<> Doc
colon
    pprint' FortranVersion
_ Only
Permissive = Doc
empty

instance Pretty (Use a) where
    pprint' :: FortranVersion -> Use a -> Doc
pprint' FortranVersion
v Use a
use
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        case Use a
use of
          UseRename a
_ SrcSpan
_ Expression a
uSrc Expression a
uDst -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
uSrc Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
uDst
          UseID a
_ SrcSpan
_ Expression a
u -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
u
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran90 = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Module system" FortranVersion
Fortran90
      | Bool
otherwise = forall a. [Char] -> a
prettyError [Char]
"unhandled version"

instance Pretty (Argument a) where
    pprint' :: FortranVersion -> Argument a -> Doc
pprint' FortranVersion
v (Argument a
_ SrcSpan
_ Maybe [Char]
key ArgumentExpression a
e) =
       case Maybe [Char]
key of
         Just [Char]
keyName -> [Char] -> Doc
text [Char]
keyName Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v ArgumentExpression a
e
         Maybe [Char]
Nothing      -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v ArgumentExpression a
e

instance Pretty (ArgumentExpression a) where
    pprint' :: FortranVersion -> ArgumentExpression a -> Doc
pprint' FortranVersion
v = \case
      ArgExpr        Expression a
e   -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
      ArgExprVar a
_ SrcSpan
_ [Char]
var -> Doc
"(" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v [Char]
var Doc -> Doc -> Doc
<> Doc
")"

instance Pretty (Attribute a) where
    pprint' :: FortranVersion -> Attribute a -> Doc
pprint' FortranVersion
v Attribute a
attr
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        case Attribute a
attr of
          AttrAsynchronous a
_ SrcSpan
_
            | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 -> Doc
"asynchronous"
            | Bool
otherwise        -> forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Asynchronous attribute" FortranVersion
Fortran2003
          AttrValue a
_ SrcSpan
_
            | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95   -> Doc
"value"
            | Bool
otherwise        -> forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Value attribute" FortranVersion
Fortran95
          AttrVolatile a
_ SrcSpan
_
            | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran95   -> Doc
"volatile"
            | Bool
otherwise        -> forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Volatile attribute" FortranVersion
Fortran95
          AttrSuffix a
_ SrcSpan
_ Suffix a
s
            | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Suffix a
s
            | Bool
otherwise        -> forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Bind (language-binding-spec) attribute" FortranVersion
Fortran2003

          AttrParameter a
_ SrcSpan
_ -> Doc
"parameter"
          AttrPublic a
_ SrcSpan
_ -> Doc
"public"
          AttrPrivate a
_ SrcSpan
_ -> Doc
"private"
          AttrProtected a
_ SrcSpan
_
            | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 -> Doc
"protected"
            | Bool
otherwise        -> forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Protected attribute" FortranVersion
Fortran2003
          AttrAllocatable a
_ SrcSpan
_ -> Doc
"allocatable"
          AttrDimension a
_ SrcSpan
_ AList DimensionDeclarator a
dims ->
            Doc
"dimension" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList DimensionDeclarator a
dims)
          AttrExternal a
_ SrcSpan
_ -> Doc
"external"
          AttrIntent a
_ SrcSpan
_ Intent
intent ->
            Doc
"intent" Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Intent
intent)
          AttrIntrinsic a
_ SrcSpan
_ -> Doc
"intrinsic"
          AttrOptional a
_ SrcSpan
_ -> Doc
"optional"
          AttrPointer a
_ SrcSpan
_ -> Doc
"pointer"
          AttrSave a
_ SrcSpan
_ -> Doc
"save"
          AttrTarget a
_ SrcSpan
_ -> Doc
"target"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Declaration attribute" FortranVersion
Fortran90

instance Pretty (Suffix a) where
  pprint' :: FortranVersion -> Suffix a -> Doc
pprint' FortranVersion
v (SfxBind a
_ SrcSpan
_ Maybe (Expression a)
mexp)
    | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"bind" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
"c" Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mexp)
    | Bool
otherwise        = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Bind suffix" FortranVersion
Fortran2003

instance Pretty Intent where
    pprint' :: FortranVersion -> Intent -> Doc
pprint' FortranVersion
v Intent
intent
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        case Intent
intent of
          Intent
In -> Doc
"in"
          Intent
Out -> Doc
"out"
          Intent
InOut -> Doc
"inout"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Declaration attribute" FortranVersion
Fortran90

-- TODO come back to this once edit descriptors are properly handled in the
-- parser.
instance Pretty (FormatItem a) where
    pprint' :: FortranVersion -> FormatItem a -> Doc
pprint' FortranVersion
_ (FIHollerith a
_ SrcSpan
_ (ValHollerith [Char]
s)) =
      [Char] -> Doc
text (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'h' Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
s
    pprint' FortranVersion
_ FormatItem a
_ = forall a. [Char] -> a
prettyError [Char]
"Not yet supported."

instance Pretty (FlushSpec a) where
  pprint' :: FortranVersion -> FlushSpec a -> Doc
pprint' FortranVersion
v (FSUnit a
_ SrcSpan
_ Expression a
e)   = Doc
"unit="   Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
  pprint' FortranVersion
v (FSIOStat a
_ SrcSpan
_ Expression a
e) = Doc
"iostat=" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
  pprint' FortranVersion
v (FSIOMsg a
_ SrcSpan
_ Expression a
e)  = Doc
"iomsg="  Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
  pprint' FortranVersion
v (FSErr a
_ SrcSpan
_ Expression a
e)    = Doc
"err="    Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e

instance Pretty (DoSpecification a) where
    pprint' :: FortranVersion -> DoSpecification a -> Doc
pprint' FortranVersion
v (DoSpecification a
_ SrcSpan
_ s :: Statement a
s@StExpressionAssign{} Expression a
limit Maybe (Expression a)
mStride) =
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Statement a
s Doc -> Doc -> Doc
<> Doc
comma
      Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
limit
      Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mStride

    -- Given DoSpec. has a single constructor, the only way for pattern
    -- match above to fail is to have the wrong type of statement embedded
    -- in it.
    pprint' FortranVersion
_ DoSpecification a
_ = forall a. [Char] -> a
prettyError [Char]
"Incorrect initialisation in DO specification."

instance Pretty (ControlPair a) where
    pprint' :: FortranVersion -> ControlPair a -> Doc
pprint' FortranVersion
v (ControlPair a
_ SrcSpan
_ Maybe [Char]
mStr Expression a
exp)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77
      , Just [Char]
str <- Maybe [Char]
mStr = [Char] -> Doc
text [Char]
str Doc -> Doc -> Doc
<> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
exp
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
< FortranVersion
Fortran77
      , Just [Char]
_ <- Maybe [Char]
mStr = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Named control pair" FortranVersion
Fortran77
      | Bool
otherwise = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
exp

instance Pretty (AllocOpt a) where
    pprint' :: FortranVersion -> AllocOpt a -> Doc
pprint' FortranVersion
v (AOStat a
_ SrcSpan
_ Expression a
e) = Doc
"stat=" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
    pprint' FortranVersion
v (AOErrMsg a
_ SrcSpan
_ Expression a
e)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"errmsg=" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
      | Bool
otherwise        = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Allocate errmsg" FortranVersion
Fortran2003
    pprint' FortranVersion
v (AOSource a
_ SrcSpan
_ Expression a
e)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran2003 = Doc
"source=" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
      | Bool
otherwise        = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Allocate source" FortranVersion
Fortran2003

instance Pretty (ImpList a) where
    pprint' :: FortranVersion -> ImpList a -> Doc
pprint' FortranVersion
v (ImpList a
_ SrcSpan
_ TypeSpec a
bt AList ImpElement a
els) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v TypeSpec a
bt Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList ImpElement a
els)

instance Pretty (CommonGroup a) where
    pprint' :: FortranVersion -> CommonGroup a -> Doc
pprint' FortranVersion
v (CommonGroup a
_ SrcSpan
_ Maybe (Expression a)
mName AList Declarator a
elems) =
      Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mName Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Declarator a
elems

instance Pretty (Namelist a) where
    pprint' :: FortranVersion -> Namelist a -> Doc
pprint' FortranVersion
Fortran90 (Namelist a
_ SrcSpan
_ Expression a
name AList Expression a
elems) =
      Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
Fortran90 Expression a
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
Fortran90 AList Expression a
elems
    pprint' FortranVersion
v Namelist a
_ = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Namelist statement" FortranVersion
Fortran90

instance Pretty (DataGroup a) where
    pprint' :: FortranVersion -> DataGroup a -> Doc
pprint' FortranVersion
v (DataGroup a
_ SrcSpan
_ AList Expression a
vars AList Expression a
exps) =
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
vars Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
exps Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/'

instance Pretty (ImpElement a) where
    pprint' :: FortranVersion -> ImpElement a -> Doc
pprint' FortranVersion
_ (ImpElement a
_ SrcSpan
_ Char
cFrom Maybe Char
mcTo) =
        case Maybe Char
mcTo of
          Maybe Char
Nothing  -> Char -> Doc
char Char
cFrom
          Just Char
cTo -> Char -> Doc
char Char
cFrom Doc -> Doc -> Doc
<> Doc
"-" Doc -> Doc -> Doc
<> Char -> Doc
char Char
cTo

instance Pretty (Expression a) where
    pprint' :: FortranVersion -> Expression a -> Doc
pprint' FortranVersion
v (ExpValue a
_ SrcSpan
_ Value a
val)  =
         forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Value a
val

    pprint' FortranVersion
v (ExpBinary a
_ SrcSpan
_ BinaryOp
op Expression a
e1 Expression a
e2) =
        Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e1 Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v BinaryOp
op Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e2)

    pprint' FortranVersion
v (ExpUnary a
_ SrcSpan
_ UnaryOp
op Expression a
e) =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v UnaryOp
op Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e

    pprint' FortranVersion
v (ExpSubscript a
_ SrcSpan
_ Expression a
e AList Index a
ixs) =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Index a
ixs)

    pprint' FortranVersion
v (ExpDataRef a
_ SrcSpan
_ Expression a
e1 Expression a
e2) =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e1 Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'%' Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e2

    pprint' FortranVersion
v (ExpFunctionCall a
_ SrcSpan
_ Expression a
e AList Argument a
mes) =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Argument a
mes)

    pprint' FortranVersion
v (ExpImpliedDo a
_ SrcSpan
_ AList Expression a
es DoSpecification a
dospec) =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
es Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v DoSpecification a
dospec

    pprint' FortranVersion
v (ExpInitialisation a
_ SrcSpan
_ AList Expression a
es) =
        Doc
"(/" Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
es Doc -> Doc -> Doc
<> Doc
"/)"

    pprint' FortranVersion
v (ExpReturnSpec a
_ SrcSpan
_ Expression a
e) =
        Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e

instance Pretty (Index a) where
    pprint' :: FortranVersion -> Index a -> Doc
pprint' FortranVersion
v (IxSingle a
_ SrcSpan
_ Maybe [Char]
Nothing Expression a
e) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
    -- This is an intermediate expression form which shouldn't make it
    -- to the pretty printer
    pprint' FortranVersion
v (IxSingle a
_ SrcSpan
_ (Just [Char]
_) Expression a
e) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
    pprint' FortranVersion
v (IxRange a
_ SrcSpan
_ Maybe (Expression a)
low Maybe (Expression a)
up Maybe (Expression a)
stride) =
       forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
low Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
up Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
stride

instance Pretty (Value a) where
    pprint' :: FortranVersion -> Value a -> Doc
pprint' FortranVersion
_ Value a
ValStar       = Char -> Doc
char Char
'*'
    pprint' FortranVersion
_ Value a
ValColon      = Char -> Doc
char Char
':'
    pprint' FortranVersion
v Value a
ValAssignment
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"assignment (=)"
      -- TODO better error message is needed. Assignment is too vague.
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Assignment" FortranVersion
Fortran90
    pprint' FortranVersion
v (ValOperator [Char]
op)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = Doc
"operator" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Char] -> Doc
text [Char]
op)
      -- TODO better error message is needed. Operator is too vague.
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Operator" FortranVersion
Fortran90
    pprint' FortranVersion
v (ValComplex ComplexLit a
c) = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v ComplexLit a
c
    pprint' FortranVersion
_ (ValString [Char]
str) = Doc -> Doc
quotes forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
str
    pprint' FortranVersion
v (ValLogical Bool
b Maybe (KindParam a)
mkp) = [Char] -> Doc
text [Char]
litStr Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (KindParam a)
mkp
      where litStr :: [Char]
litStr = if Bool
b then [Char]
".true." else [Char]
".false."
    pprint' FortranVersion
v (ValInteger [Char]
i Maybe (KindParam a)
mkp) = [Char] -> Doc
text [Char]
i Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (KindParam a)
mkp
    pprint' FortranVersion
v (ValReal RealLit
rl Maybe (KindParam a)
mkp) = [Char] -> Doc
text (RealLit -> [Char]
prettyHsRealLit RealLit
rl) Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (KindParam a)
mkp
    pprint' FortranVersion
_ (ValBoz Boz
b) = [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$ Boz -> [Char]
prettyBoz Boz
b

    pprint' FortranVersion
_ (ValHollerith [Char]
s) = [Char] -> Doc
text [Char]
s
    pprint' FortranVersion
_ (ValVariable  [Char]
s) = [Char] -> Doc
text [Char]
s
    pprint' FortranVersion
_ (ValIntrinsic [Char]
s) = [Char] -> Doc
text [Char]
s
    pprint' FortranVersion
_ (ValType      [Char]
s) = [Char] -> Doc
text [Char]
s

instance Pretty (ComplexLit a) where
    pprint' :: FortranVersion -> ComplexLit a -> Doc
pprint' FortranVersion
v ComplexLit a
c = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commaSep [Doc
realPart, Doc
imagPart]
      where realPart :: Doc
realPart = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a. ComplexLit a -> ComplexPart a
complexLitRealPart ComplexLit a
c)
            imagPart :: Doc
imagPart = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a. ComplexLit a -> ComplexPart a
complexLitImagPart ComplexLit a
c)

instance Pretty (KindParam a) where
    pprint' :: FortranVersion -> KindParam a -> Doc
pprint' FortranVersion
_ KindParam a
kp = [Char] -> Doc
text [Char]
"_" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
kp'
      where kp' :: [Char]
kp' = case KindParam a
kp of KindParamInt a
_ SrcSpan
_ [Char]
i -> [Char]
i
                             KindParamVar a
_ SrcSpan
_ [Char]
v -> [Char]
v

instance Pretty (ComplexPart a) where
    pprint' :: FortranVersion -> ComplexPart a -> Doc
pprint' FortranVersion
v = \case
      ComplexPartReal   a
_ SrcSpan
_ RealLit
rl Maybe (KindParam a)
mkp -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a. RealLit -> Maybe (KindParam a) -> Value a
ValReal    RealLit
rl Maybe (KindParam a)
mkp)
      ComplexPartInt    a
_ SrcSpan
_ [Char]
i  Maybe (KindParam a)
mkp -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a. [Char] -> Maybe (KindParam a) -> Value a
ValInteger [Char]
i  Maybe (KindParam a)
mkp)
      ComplexPartNamed  a
_ SrcSpan
_ [Char]
var    -> [Char] -> Doc
text [Char]
var

instance IndentablePretty (StructureItem a) where
  pprint :: FortranVersion -> StructureItem a -> Indentation -> Doc
pprint FortranVersion
v (StructFields a
a SrcSpan
s TypeSpec a
spec Maybe (AList Attribute a)
mAttrs AList Declarator a
decls) Indentation
_ = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a.
a
-> SrcSpan
-> TypeSpec a
-> Maybe (AList Attribute a)
-> AList Declarator a
-> Statement a
StDeclaration a
a SrcSpan
s TypeSpec a
spec Maybe (AList Attribute a)
mAttrs AList Declarator a
decls)
  pprint FortranVersion
v (StructUnion a
_ SrcSpan
_ AList UnionMap a
maps) Indentation
i =
    Doc
"union" Doc -> Doc -> Doc
<> Doc
newline Doc -> Doc -> Doc
<>
    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
doc UnionMap a
item -> Doc
doc Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v UnionMap a
item (Indentation -> Indentation
incIndentation Indentation
i) Doc -> Doc -> Doc
<> Doc
newline) Doc
empty (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList UnionMap a
maps) Doc -> Doc -> Doc
<>
    Doc
"end union"
  pprint FortranVersion
v (StructStructure a
a SrcSpan
s Maybe [Char]
mName [Char]
_ AList StructureItem a
items) Indentation
_ = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v (forall a.
a
-> SrcSpan -> Maybe [Char] -> AList StructureItem a -> Statement a
StStructure a
a SrcSpan
s Maybe [Char]
mName AList StructureItem a
items)

instance IndentablePretty (UnionMap a) where
  pprint :: FortranVersion -> UnionMap a -> Indentation -> Doc
pprint FortranVersion
v (UnionMap a
_ SrcSpan
_ AList StructureItem a
items) Indentation
i =
    Doc
"map" Doc -> Doc -> Doc
<> Doc
newline Doc -> Doc -> Doc
<>
    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
doc StructureItem a
item -> Doc
doc Doc -> Doc -> Doc
<> forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> Doc
pprint FortranVersion
v StructureItem a
item (Indentation -> Indentation
incIndentation Indentation
i) Doc -> Doc -> Doc
<> Doc
newline) Doc
empty (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList StructureItem a
items) Doc -> Doc -> Doc
<>
    Doc
"end map"

instance Pretty (Declarator a) where
    pprint' :: FortranVersion -> Declarator a -> Doc
pprint' FortranVersion
v (Declarator a
_ SrcSpan
_ Expression a
e DeclaratorType a
ScalarDecl Maybe (Expression a)
mLen Maybe (Expression a)
mInit)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<>
        Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<?> Maybe (Expression a) -> Doc
noParensLit' Maybe (Expression a)
mLen Doc -> Doc -> Doc
<+>
        Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<?+> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mInit
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 =
        case Maybe (Expression a)
mInit of
          Maybe (Expression a)
Nothing -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<>
                     Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<?> Maybe (Expression a) -> Doc
noParensLit' Maybe (Expression a)
mLen
          Just Expression a
initial -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<>
                       Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<?> Maybe (Expression a) -> Doc
noParensLit' Maybe (Expression a)
mLen Doc -> Doc -> Doc
<>
                       Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
initial Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/'

      | Maybe (Expression a)
Nothing <- Maybe (Expression a)
mLen
      , Maybe (Expression a)
Nothing <- Maybe (Expression a)
mInit = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e
      | Just Expression a
_ <- Maybe (Expression a)
mInit = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Variable initialisation" FortranVersion
Fortran90
      | Just Expression a
_ <- Maybe (Expression a)
mLen = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Variable width" FortranVersion
Fortran77
      where noParensLit' :: Maybe (Expression a) -> Doc
noParensLit' = forall a. (a -> Doc) -> Maybe a -> Doc
printMaybe (forall a. FortranVersion -> Expression a -> Doc
noParensLit FortranVersion
v)

    pprint' FortranVersion
v (Declarator a
_ SrcSpan
_ Expression a
e (ArrayDecl AList DimensionDeclarator a
dims) Maybe (Expression a)
mLen Maybe (Expression a)
mInit)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 =
        forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList DimensionDeclarator a
dims) Doc -> Doc -> Doc
<+>
        Doc
"*" Doc -> Doc -> Doc
<?> Maybe (Expression a) -> Doc
noParensLit' Maybe (Expression a)
mLen Doc -> Doc -> Doc
<+>
        Doc
equals Doc -> Doc -> Doc
<?> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
mInit

      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 =
        case Maybe (Expression a)
mInit of
          Maybe (Expression a)
Nothing -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList DimensionDeclarator a
dims) Doc -> Doc -> Doc
<>
                     Doc
"*" Doc -> Doc -> Doc
<?> Maybe (Expression a) -> Doc
noParensLit' Maybe (Expression a)
mLen
          Just Expression a
initial ->
            let initDoc :: Doc
initDoc = case Expression a
initial of
                  ExpInitialisation a
_ SrcSpan
_ AList Expression a
es ->
                    Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList Expression a
es Doc -> Doc -> Doc
<> Char -> Doc
char Char
'/'
                  Expression a
e' -> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e'
            in forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList DimensionDeclarator a
dims) Doc -> Doc -> Doc
<>
               Doc
"*" Doc -> Doc -> Doc
<?> Maybe (Expression a) -> Doc
noParensLit' Maybe (Expression a)
mLen Doc -> Doc -> Doc
<> Doc
initDoc

      | Maybe (Expression a)
Nothing <- Maybe (Expression a)
mLen
      , Maybe (Expression a)
Nothing <- Maybe (Expression a)
mInit = forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Expression a
e Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v AList DimensionDeclarator a
dims)
      | Just Expression a
_ <- Maybe (Expression a)
mInit = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Variable initialisation" FortranVersion
Fortran90
      | Just Expression a
_ <- Maybe (Expression a)
mLen = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Variable width" FortranVersion
Fortran77
      where noParensLit' :: Maybe (Expression a) -> Doc
noParensLit' = forall a. (a -> Doc) -> Maybe a -> Doc
printMaybe (forall a. FortranVersion -> Expression a -> Doc
noParensLit FortranVersion
v)

instance Pretty (DimensionDeclarator a) where
    pprint' :: FortranVersion -> DimensionDeclarator a -> Doc
pprint' FortranVersion
v (DimensionDeclarator a
_ SrcSpan
_ Maybe (Expression a)
me1 Maybe (Expression a)
me2) =
      forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
me1 Doc -> Doc -> Doc
<?> Doc
colon Doc -> Doc -> Doc
<> forall t. Pretty t => FortranVersion -> t -> Doc
pprint' FortranVersion
v Maybe (Expression a)
me2

instance Pretty UnaryOp where
    pprint' :: FortranVersion -> UnaryOp -> Doc
pprint' FortranVersion
_ UnaryOp
Plus  = Char -> Doc
char Char
'+'
    pprint' FortranVersion
_ UnaryOp
Minus = Char -> Doc
char Char
'-'
    pprint' FortranVersion
_ UnaryOp
Not   = Doc
".not."
    pprint' FortranVersion
v (UnCustom [Char]
custom)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$ [Char]
"." forall a. [a] -> [a] -> [a]
++ [Char]
custom forall a. [a] -> [a] -> [a]
++ [Char]
"."
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Custom unary operator" FortranVersion
Fortran90

instance Pretty BinaryOp where
    pprint' :: FortranVersion -> BinaryOp -> Doc
pprint' FortranVersion
_ BinaryOp
Addition       = Char -> Doc
char Char
'+'
    pprint' FortranVersion
_ BinaryOp
Subtraction    = Char -> Doc
char Char
'-'
    pprint' FortranVersion
_ BinaryOp
Multiplication = Char -> Doc
char Char
'*'
    pprint' FortranVersion
_ BinaryOp
Division       = Char -> Doc
char Char
'/'
    pprint' FortranVersion
_ BinaryOp
Exponentiation = Doc
"**"
    pprint' FortranVersion
v BinaryOp
Concatenation
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 = Doc
"//"
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Character type" FortranVersion
Fortran77
    pprint' FortranVersion
v BinaryOp
GT  = if FortranVersion
v forall a. Ord a => a -> a -> Bool
<= FortranVersion
Fortran77Extended then Doc
".gt." else Doc
">"
    pprint' FortranVersion
v BinaryOp
LT  = if FortranVersion
v forall a. Ord a => a -> a -> Bool
<= FortranVersion
Fortran77Extended then Doc
".lt." else Doc
"<"
    pprint' FortranVersion
v BinaryOp
LTE = if FortranVersion
v forall a. Ord a => a -> a -> Bool
<= FortranVersion
Fortran77Extended then Doc
".le." else Doc
"<="
    pprint' FortranVersion
v BinaryOp
GTE = if FortranVersion
v forall a. Ord a => a -> a -> Bool
<= FortranVersion
Fortran77Extended then Doc
".ge." else Doc
">="
    pprint' FortranVersion
v BinaryOp
EQ  = if FortranVersion
v forall a. Ord a => a -> a -> Bool
<= FortranVersion
Fortran77Extended then Doc
".eq." else Doc
"=="
    pprint' FortranVersion
v BinaryOp
NE  = if FortranVersion
v forall a. Ord a => a -> a -> Bool
<= FortranVersion
Fortran77Extended then Doc
".ne." else Doc
"/="
    pprint' FortranVersion
_ BinaryOp
Or  = Doc
".or."
    pprint' FortranVersion
_ BinaryOp
XOr = Doc
".xor."
    pprint' FortranVersion
_ BinaryOp
And = Doc
".and."
    pprint' FortranVersion
v BinaryOp
Equivalent
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 = Doc
".eqv."
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
".EQV. operator" FortranVersion
Fortran77
    pprint' FortranVersion
v BinaryOp
NotEquivalent
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran77 = Doc
".neqv."
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
".NEQV. operator" FortranVersion
Fortran77
    pprint' FortranVersion
v (BinCustom [Char]
custom)
      | FortranVersion
v forall a. Ord a => a -> a -> Bool
>= FortranVersion
Fortran90 = [Char] -> Doc
text [Char]
custom
      | Bool
otherwise = forall a. FortranVersion -> [Char] -> FortranVersion -> a
tooOld FortranVersion
v [Char]
"Custom binary operator" FortranVersion
Fortran90

commaSep :: [Doc] -> Doc
commaSep :: [Doc] -> Doc
commaSep = [Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
", "

data ReformatState
  -- | Unsure yet whether current line it's a comment or statement.
  = RefmtStNewline Int

  -- | Current line is a comment; no need to track column number.
  | RefmtStComment

  -- | Current line is a statement.
  | RefmtStStmt Int
    deriving (ReformatState -> ReformatState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReformatState -> ReformatState -> Bool
$c/= :: ReformatState -> ReformatState -> Bool
== :: ReformatState -> ReformatState -> Bool
$c== :: ReformatState -> ReformatState -> Bool
Eq, Eq ReformatState
ReformatState -> ReformatState -> Bool
ReformatState -> ReformatState -> Ordering
ReformatState -> ReformatState -> ReformatState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReformatState -> ReformatState -> ReformatState
$cmin :: ReformatState -> ReformatState -> ReformatState
max :: ReformatState -> ReformatState -> ReformatState
$cmax :: ReformatState -> ReformatState -> ReformatState
>= :: ReformatState -> ReformatState -> Bool
$c>= :: ReformatState -> ReformatState -> Bool
> :: ReformatState -> ReformatState -> Bool
$c> :: ReformatState -> ReformatState -> Bool
<= :: ReformatState -> ReformatState -> Bool
$c<= :: ReformatState -> ReformatState -> Bool
< :: ReformatState -> ReformatState -> Bool
$c< :: ReformatState -> ReformatState -> Bool
compare :: ReformatState -> ReformatState -> Ordering
$ccompare :: ReformatState -> ReformatState -> Ordering
Ord, Int -> ReformatState -> ShowS
[ReformatState] -> ShowS
ReformatState -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ReformatState] -> ShowS
$cshowList :: [ReformatState] -> ShowS
show :: ReformatState -> [Char]
$cshow :: ReformatState -> [Char]
showsPrec :: Int -> ReformatState -> ShowS
$cshowsPrec :: Int -> ReformatState -> ShowS
Show)

-- | Add continuations where required to a pretty-printed program.
--
-- Ensures that no non-comment line exceeds 72 columns.
--
-- The reformatting should be compatible with fixed and free-form Fortran
-- standards. See: http://fortranwiki.org/fortran/show/Continuation+lines
--
-- This is a simple, delicate algorithm that must only be used on pretty printer
-- output, due to relying on particular parser & pretty printer behaviour. In
-- particular, comments not beginning a line (e.g. after a statement or
-- continuation) won't be picked up as a comment, so could wreck that line. Be
-- warned if you're using it on piles of funky-looking code!
reformatMixedFormInsertContinuations :: String -> String
reformatMixedFormInsertContinuations :: ShowS
reformatMixedFormInsertContinuations = ReformatState -> ShowS
go ReformatState
stNewline
  where
    go :: ReformatState -> String -> String

    -- all states: end on empty, break on newline
    go :: ReformatState -> ShowS
go ReformatState
_ []        = []
    go ReformatState
_ (Char
'\n':[Char]
xs) = Char
'\n' forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go ReformatState
stNewline [Char]
xs

    -- in comment: skip
    go ReformatState
RefmtStComment       (Char
x:[Char]
xs) = Char
x forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go ReformatState
RefmtStComment [Char]
xs

    -- newline F77 override: if 'c' in first column, it's a comment
    go (RefmtStNewline Int
0) (Char
'c':[Char]
xs) = Char
'c' forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go ReformatState
RefmtStComment [Char]
xs

    -- line type uncertain: consume up to non-space, then decide
    go (RefmtStNewline Int
col) (Char
x:[Char]
xs) =
        case Char
x of
            Char
' ' -> Char
' ' forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go (Int -> ReformatState
RefmtStNewline (Int
colforall a. Num a => a -> a -> a
+Int
1)) [Char]
xs
            Char
'!' -> Char
'!' forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go ReformatState
RefmtStComment           [Char]
xs
            Char
_   -> Char
x   forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go (Int -> ReformatState
RefmtStStmt    (Int
colforall a. Num a => a -> a -> a
+Int
1)) [Char]
xs

    -- in statement: break when required
    go (RefmtStStmt Int
col)    (Char
x:[Char]
xs)
      | Int
col forall a. Eq a => a -> a -> Bool
== Int
maxCol =
            -- lookahead: if next is newline or EOF, we don't need to break
            case [Char]
xs of
                []   -> Char
x forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go (Int -> ReformatState
RefmtStStmt (Int
colforall a. Num a => a -> a -> a
+Int
1)) [Char]
xs
                Char
x':[Char]
_ ->
                    case Char
x' of
                        Char
'\n' -> Char
x forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go (Int -> ReformatState
RefmtStStmt (Int
colforall a. Num a => a -> a -> a
+Int
1)) [Char]
xs
                        Char
_    ->
                            -- pretend to continue, but we know that we'll break
                            -- on newline next
                            Char
'&' forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go (Int -> ReformatState
RefmtStStmt (Int
colforall a. Num a => a -> a -> a
+Int
1)) ([Char]
"\n     &" forall a. [a] -> [a] -> [a]
++ Char
xforall a. a -> [a] -> [a]
:[Char]
xs)
      | Bool
otherwise     = Char
x forall a. a -> [a] -> [a]
: ReformatState -> ShowS
go (Int -> ReformatState
RefmtStStmt (Int
colforall a. Num a => a -> a -> a
+Int
1)) [Char]
xs

    maxCol :: Int
maxCol = Int
72
    stNewline :: ReformatState
stNewline = Int -> ReformatState
RefmtStNewline Int
0

----

-- | 'error' wrapper to make it easier to swap this out for a monad later.
prettyError :: String -> a
prettyError :: forall a. [Char] -> a
prettyError = forall a. HasCallStack => [Char] -> a
error