{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, UndecidableInstances #-}

-- | This module exports the instances of the 'Pretty' type class necessary for printing of an Oberon abstract syntax
-- tree. Note that the AST cannot be ambiguous to be pretty-printed, so it must be resolved after parsing.

module Language.Oberon.Pretty (Precedence(Precedence)) where

import Control.Applicative (ZipList(ZipList, getZipList))
import Data.Char (toUpper)
import Data.Functor.Identity (Identity(..))
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty((:|)), toList)
import qualified Data.Text as Text
import Data.Text.Prettyprint.Doc
import Numeric (showHex)

import qualified Language.Oberon.Abstract as Abstract
import Language.Oberon.AST

data Precedence e = Precedence Int e

instance (Pretty (Abstract.Import l), Pretty (Abstract.Block l l Identity Identity)) =>
         Pretty (Module λ l Identity Identity) where
   pretty :: Module λ l Identity Identity -> Doc ann
pretty (Module Ident
name [Import l]
imports Identity (Block l l Identity Identity)
body) =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall a. Monoid a => a
mempty ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$
      [Doc ann
"MODULE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi,
       if [Import l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import l]
imports then Doc ann
forall a. Monoid a => a
mempty
       else Doc ann
"IMPORT" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Import l -> Doc ann
forall a a ann. (Pretty a, Pretty a) => (Maybe a, a) -> Doc ann
prettyImport (Import l -> Doc ann) -> [Import l] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import l]
imports)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi,
       Identity (Block l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
       Doc ann
"END" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line]
      where prettyImport :: (Maybe a, a) -> Doc ann
prettyImport (Maybe a
Nothing, a
mod) = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
mod
            prettyImport (Just a
inner, a
mod) = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
inner Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
mod

instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l), Pretty (Abstract.Type l l Identity Identity),
          Pretty (Abstract.Declaration l l Identity Identity),
          Pretty (Abstract.Expression l l Identity Identity), Pretty (Abstract.FormalParameters l l Identity Identity),
          Pretty (Abstract.ProcedureHeading l l Identity Identity),
          Pretty (Abstract.Block l l Identity Identity)) =>
         Pretty (Declaration λ l Identity Identity) where
   pretty :: Declaration λ l Identity Identity -> Doc ann
pretty (ConstantDeclaration IdentDef l
ident (Identity Expression l l Identity Identity
expr)) = Doc ann
"CONST" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expression l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expression l l Identity Identity
expr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (TypeDeclaration IdentDef l
ident Identity (Type l l Identity Identity)
typeDef) = Doc ann
"TYPE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
typeDef Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (VariableDeclaration IdentList l
idents Identity (Type l l Identity Identity)
varType) =
      Doc ann
"VAR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (IdentDef l -> Doc ann) -> [IdentDef l] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentList l -> [IdentDef l]
forall a. NonEmpty a -> [a]
toList IdentList l
idents) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
varType Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (ProcedureDeclaration Identity (ProcedureHeading l l Identity Identity)
heading Identity (Block l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Identity (ProcedureHeading l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ProcedureHeading l l Identity Identity)
heading Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi,
                                                      Identity (Block l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
                                                      Doc ann
"END" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ProcedureHeading l l Identity Identity -> Ident
forall l l' (f' :: * -> *) (f :: * -> *).
(Nameable l, Nameable l') =>
ProcedureHeading l l' f' f -> Ident
Abstract.getProcedureName (ProcedureHeading l l Identity Identity -> Ident)
-> ProcedureHeading l l Identity Identity -> Ident
forall a b. (a -> b) -> a -> b
$ Identity (ProcedureHeading l l Identity Identity)
-> ProcedureHeading l l Identity Identity
forall a. Identity a -> a
runIdentity Identity (ProcedureHeading l l Identity Identity)
heading)
                                                      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi]
   pretty (ForwardDeclaration IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"^" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe (Identity (FormalParameters l l Identity Identity))
-> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi

instance Pretty (IdentDef l) where
   pretty :: IdentDef l -> Doc ann
pretty (IdentDef Ident
name AccessMode
Exported) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"*"
   pretty (IdentDef Ident
name AccessMode
ReadOnly) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"-"
   pretty (IdentDef Ident
name AccessMode
PrivateOnly) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name

instance  (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
           Pretty (Abstract.Expression l l Identity Identity),
           Pretty (Abstract.Element l l Identity Identity),
           Pretty (Abstract.Designator l l Identity Identity),
           Pretty (Abstract.Value l l Identity Identity),
           Pretty (Abstract.QualIdent l)) => Pretty (Expression λ l Identity Identity) where
   pretty :: Expression λ l Identity Identity -> Doc ann
pretty Expression λ l Identity Identity
e = Precedence (Expression λ l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int
-> Expression λ l Identity Identity
-> Precedence (Expression λ l Identity Identity)
forall e. Int -> e -> Precedence e
Precedence Int
0 Expression λ l Identity Identity
e)
   
instance  (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
           Pretty (Abstract.Expression l l Identity Identity),
           Pretty (Abstract.Element l l Identity Identity),
           Pretty (Abstract.Designator l l Identity Identity),
           Pretty (Abstract.QualIdent l),
           Pretty (Abstract.Value l l Identity Identity)) =>
          Pretty (Precedence (Expression λ l Identity Identity)) where
   pretty :: Precedence (Expression λ l Identity Identity) -> Doc ann
pretty (Precedence Int
0 (Relation RelOp
op Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> RelOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty RelOp
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
0 (IsA Identity (Expression l l Identity Identity)
left QualIdent l
right)) = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"IS" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
right
   pretty (Precedence Int
p (Add Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (Subtract Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (Or Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (Positive Identity (Expression l l Identity Identity)
e)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = Doc ann
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
3 Identity (Expression l l Identity Identity)
e
   pretty (Precedence Int
p (Negative Identity (Expression l l Identity Identity)
e)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
3 Identity (Expression l l Identity Identity)
e
   pretty (Precedence Int
p (Multiply Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"*" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (Divide Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"/" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (IntegerDivide Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DIV" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (Modulo Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"MOD" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
p (And Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"&" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
   pretty (Precedence Int
_ (Set ZipList (Identity (Element l l Identity Identity))
elements)) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Element l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Element l l Identity Identity -> Doc ann)
-> (Identity (Element l l Identity Identity)
    -> Element l l Identity Identity)
-> Identity (Element l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Element l l Identity Identity)
-> Element l l Identity Identity
forall a. Identity a -> a
runIdentity (Identity (Element l l Identity Identity) -> Doc ann)
-> [Identity (Element l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Element l l Identity Identity))
-> [Identity (Element l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Element l l Identity Identity))
elements)
   pretty (Precedence Int
_ (Read (Identity Designator l l Identity Identity
var))) = Designator l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
var
   pretty (Precedence Int
_ (FunctionCall (Identity Designator l l Identity Identity
fun) ZipList (Identity (Expression l l Identity Identity))
parameters)) =
      Designator l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
fun Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Expression l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Expression l l Identity Identity -> Doc ann)
-> (Identity (Expression l l Identity Identity)
    -> Expression l l Identity Identity)
-> Identity (Expression l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Expression l l Identity Identity)
-> Expression l l Identity Identity
forall a. Identity a -> a
runIdentity (Identity (Expression l l Identity Identity) -> Doc ann)
-> [Identity (Expression l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Expression l l Identity Identity))
-> [Identity (Expression l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Expression l l Identity Identity))
parameters)
   pretty (Precedence Int
_ (Literal (Identity Value l l Identity Identity
val))) = Value l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value l l Identity Identity
val
   pretty (Precedence Int
p (Not Identity (Expression l l Identity Identity)
e)) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = Doc ann
"~" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Identity (Expression l l Identity Identity) -> Doc ann
forall e ann. Pretty (Precedence e) => Int -> Identity e -> Doc ann
prettyPrec' Int
5 Identity (Expression l l Identity Identity)
e
   pretty (Precedence Int
_ Expression λ l Identity Identity
e) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Expression λ l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expression λ l Identity Identity
e)

prettyPrec' :: Int -> Identity e -> Doc ann
prettyPrec' Int
p (Identity e
e) = Precedence e -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> e -> Precedence e
forall e. Int -> e -> Precedence e
Precedence Int
p e
e)

instance Pretty RelOp where
   pretty :: RelOp -> Doc ann
pretty RelOp
Equal = Doc ann
"="
   pretty RelOp
Unequal = Doc ann
"#"
   pretty RelOp
Less = Doc ann
"<"
   pretty RelOp
LessOrEqual =  Doc ann
"<="
   pretty RelOp
Greater = Doc ann
">"
   pretty RelOp
GreaterOrEqual = Doc ann
">="
   pretty RelOp
In = Doc ann
"IN"

instance Pretty (Abstract.Expression l l Identity Identity) => Pretty (Element λ l Identity Identity) where
   pretty :: Element λ l Identity Identity -> Doc ann
pretty (Element Identity (Expression l l Identity Identity)
e) = Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
e
   pretty (Range Identity (Expression l l Identity Identity)
from Identity (Expression l l Identity Identity)
to) = Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
from Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
to

instance Pretty (Value Language l Identity Identity) where
   pretty :: Value Language l Identity Identity -> Doc ann
pretty (Boolean Bool
False) = Doc ann
"FALSE"
   pretty (Boolean Bool
True) = Doc ann
"TRUE"
   pretty (Integer Integer
n) = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n
   pretty (Real Double
r) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
r)
   pretty (CharCode Int
c) = Doc ann
"0" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Int
c [Char]
"") Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"X"
   pretty (String Ident
s)
      | (Char -> Bool) -> Ident -> Bool
Text.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') Ident
s = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
s)
      | Bool
otherwise = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
s)
   pretty Value Language l Identity Identity
Nil = Doc ann
"NIL"
   pretty (Builtin Ident
name) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name


instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.Expression l l Identity Identity)) => Pretty (Designator λ l Identity Identity) where
   pretty :: Designator λ l Identity Identity -> Doc ann
pretty (Variable QualIdent l
q) = QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
q
   pretty (Field Identity (Designator l l Identity Identity)
record Ident
name) = Identity (Designator l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
record Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
dot Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name
   pretty (Index Identity (Designator l l Identity Identity)
array Identity (Expression l l Identity Identity)
index ZipList (Identity (Expression l l Identity Identity))
indexes) = Identity (Designator l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
array Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma
                                                                  ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Expression l l Identity Identity) -> Doc ann)
-> [Identity (Expression l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (Expression l l Identity Identity)
index Identity (Expression l l Identity Identity)
-> [Identity (Expression l l Identity Identity)]
-> [Identity (Expression l l Identity Identity)]
forall a. a -> [a] -> [a]
: ZipList (Identity (Expression l l Identity Identity))
-> [Identity (Expression l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Expression l l Identity Identity))
indexes)
   pretty (TypeGuard Identity (Designator l l Identity Identity)
scrutinee QualIdent l
typeName) = Identity (Designator l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
scrutinee Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
typeName)
   pretty (Dereference Identity (Designator l l Identity Identity)
pointer) = Identity (Designator l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
pointer Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"^"

instance (Pretty (Abstract.FormalParameters l l Identity Identity), Pretty (Abstract.FieldList l l Identity Identity),
          Pretty (Abstract.ConstExpression l l Identity Identity), Pretty (Abstract.Type l l Identity Identity),
          Pretty (Abstract.BaseType l)) => Pretty (Type λ l Identity Identity) where
   pretty :: Type λ l Identity Identity -> Doc ann
pretty (TypeReference BaseType l
q) = BaseType l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BaseType l
q
   pretty (ArrayType ZipList (Identity (ConstExpression l l Identity Identity))
dimensions Identity (Type l l Identity Identity)
itemType) =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
"ARRAY" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (ConstExpression l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ConstExpression l l Identity Identity -> Doc ann)
-> (Identity (ConstExpression l l Identity Identity)
    -> ConstExpression l l Identity Identity)
-> Identity (ConstExpression l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (ConstExpression l l Identity Identity)
-> ConstExpression l l Identity Identity
forall a. Identity a -> a
runIdentity (Identity (ConstExpression l l Identity Identity) -> Doc ann)
-> [Identity (ConstExpression l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (ConstExpression l l Identity Identity))
-> [Identity (ConstExpression l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (ConstExpression l l Identity Identity))
dimensions)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
itemType
   pretty (RecordType Maybe (BaseType l)
baseType ZipList (Identity (FieldList l l Identity Identity))
fields) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"RECORD" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (BaseType l -> Doc ann) -> Maybe (BaseType l) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann)
-> (BaseType l -> Doc ann) -> BaseType l -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (BaseType l)
baseType,
                                               Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (FieldList l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (FieldList l l Identity Identity) -> Doc ann)
-> [Identity (FieldList l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (FieldList l l Identity Identity))
-> [Identity (FieldList l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (FieldList l l Identity Identity))
fields),
                                               Doc ann
"END"]
   pretty (PointerType Identity (Type l l Identity Identity)
pointed) = Doc ann
"POINTER" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
pointed
   pretty (ProcedureType Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe (Identity (FormalParameters l l Identity Identity))
-> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters

instance Pretty (QualIdent l) where
   pretty :: QualIdent l -> Doc ann
pretty (QualIdent Ident
moduleName Ident
memberName) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
moduleName Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
memberName
   pretty (NonQualIdent Ident
localName) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
localName

instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.Type l l Identity Identity)) =>
         Pretty (FieldList λ l Identity Identity) where
   pretty :: FieldList λ l Identity Identity -> Doc ann
pretty (FieldList IdentList l
names Identity (Type l l Identity Identity)
t) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (IdentDef l -> Doc ann) -> [IdentDef l] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentList l -> [IdentDef l]
forall a. NonEmpty a -> [a]
toList IdentList l
names) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
t

instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.FormalParameters l l Identity Identity),
          Pretty (Abstract.Type l l Identity Identity)) =>
         Pretty (ProcedureHeading λ l Identity Identity) where
   pretty :: ProcedureHeading λ l Identity Identity -> Doc ann
pretty (ProcedureHeading Bool
indirect IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) =
      Doc ann
"PROCEDURE" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
indirect then Doc ann
"* " else Doc ann
forall ann. Doc ann
space) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (Identity (FormalParameters l l Identity Identity))
-> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters
   pretty (TypeBoundHeading Bool
var Ident
receiverName Ident
receiverType Bool
indirect IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) =
      Doc ann
"PROCEDURE" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space 
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ((if Bool
var then Doc ann
"VAR " else Doc ann
forall a. Monoid a => a
mempty) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
receiverName Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
receiverType)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
indirect then Doc ann
"* " else Doc ann
forall ann. Doc ann
space) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (Identity (FormalParameters l l Identity Identity))
-> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters

instance (Pretty (Abstract.FPSection l l Identity Identity),
          Pretty (Abstract.ReturnType l)) => Pretty (FormalParameters λ l Identity Identity) where
   pretty :: FormalParameters λ l Identity Identity -> Doc ann
pretty (FormalParameters ZipList (Identity (FPSection l l Identity Identity))
sections Maybe (ReturnType l)
result) =
      Doc ann
forall ann. Doc ann
lparen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (FPSection l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (FPSection l l Identity Identity) -> Doc ann)
-> [Identity (FPSection l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (FPSection l l Identity Identity))
-> [Identity (FPSection l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (FPSection l l Identity Identity))
sections) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rparen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Doc ann -> Doc ann) -> Maybe (Doc ann) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (ReturnType l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ReturnType l -> Doc ann)
-> Maybe (ReturnType l) -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ReturnType l)
result)

instance Pretty (Abstract.Type l l Identity Identity) => Pretty (FPSection λ l Identity Identity) where
   pretty :: FPSection λ l Identity Identity -> Doc ann
pretty (FPSection Bool
var [Ident]
names Identity (Type l l Identity Identity)
t) =
      (if Bool
var then (Doc ann
"VAR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) else Doc ann -> Doc ann
forall a. a -> a
id) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Ident -> Doc ann) -> [Ident] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
names) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
t)
   
instance (Pretty (Abstract.Declaration l l Identity Identity), Pretty (Abstract.StatementSequence l l Identity Identity)) =>
         Pretty (Block λ l Identity Identity) where
   pretty :: Block λ l Identity Identity -> Doc ann
pretty (Block ZipList (Identity (Declaration l l Identity Identity))
declarations Maybe (Identity (StatementSequence l l Identity Identity))
body) =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (Doc ann -> Doc ann)
-> (Identity (Declaration l l Identity Identity) -> Doc ann)
-> Identity (Declaration l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Declaration l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Declaration l l Identity Identity) -> Doc ann)
-> [Identity (Declaration l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Declaration l l Identity Identity))
-> [Identity (Declaration l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Declaration l l Identity Identity))
declarations)
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"BEGIN", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
body)

instance Pretty (Abstract.Statement l l Identity Identity) => Pretty (StatementSequence λ l Identity Identity) where
   pretty :: StatementSequence λ l Identity Identity -> Doc ann
pretty (StatementSequence ZipList (Identity (Statement l l Identity Identity))
statements) = [Statement l l Identity Identity] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Statement l l Identity Identity)
-> Statement l l Identity Identity
forall a. Identity a -> a
runIdentity (Identity (Statement l l Identity Identity)
 -> Statement l l Identity Identity)
-> [Identity (Statement l l Identity Identity)]
-> [Statement l l Identity Identity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Statement l l Identity Identity))
-> [Identity (Statement l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Statement l l Identity Identity))
statements)

instance (Pretty (Abstract.ConstExpression l l Identity Identity),
          Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.Case l l Identity Identity),
          Pretty (Abstract.ConditionalBranch l l Identity Identity),
          Pretty (Abstract.WithAlternative l l Identity Identity),
          Pretty (Abstract.StatementSequence l l Identity Identity)) => Pretty (Statement λ l Identity Identity) where
   prettyList :: [Statement λ l Identity Identity] -> Doc ann
prettyList [Statement λ l Identity Identity]
l = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> [Doc ann]
forall a. [a] -> [a]
dropEmptyTail ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Statement λ l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Statement λ l Identity Identity -> Doc ann)
-> [Statement λ l Identity Identity] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement λ l Identity Identity]
l)
      where dropEmptyTail :: [a] -> [a]
dropEmptyTail
               | Bool -> Bool
not ([Statement λ l Identity Identity] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Statement λ l Identity Identity]
l), Statement λ l Identity Identity
EmptyStatement <- [Statement λ l Identity Identity]
-> Statement λ l Identity Identity
forall a. [a] -> a
last [Statement λ l Identity Identity]
l = [a] -> [a]
forall a. [a] -> [a]
init
               | Bool
otherwise = [a] -> [a]
forall a. a -> a
id
   pretty :: Statement λ l Identity Identity -> Doc ann
pretty Statement λ l Identity Identity
EmptyStatement = Doc ann
forall a. Monoid a => a
mempty
   pretty (Assignment (Identity Designator l l Identity Identity
destination) Identity (ConstExpression l l Identity Identity)
expression) = Designator l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
destination Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
expression
   pretty (ProcedureCall (Identity Designator l l Identity Identity
procedure) Maybe (ZipList (Identity (ConstExpression l l Identity Identity)))
parameters) =
      Designator l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
procedure Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ([Identity (ConstExpression l l Identity Identity)] -> Doc ann)
-> Maybe [Identity (ConstExpression l l Identity Identity)]
-> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann)
-> ([Identity (ConstExpression l l Identity Identity)] -> Doc ann)
-> [Identity (ConstExpression l l Identity Identity)]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann)
-> ([Identity (ConstExpression l l Identity Identity)]
    -> [Doc ann])
-> [Identity (ConstExpression l l Identity Identity)]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann])
-> ([Identity (ConstExpression l l Identity Identity)]
    -> [Doc ann])
-> [Identity (ConstExpression l l Identity Identity)]
-> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (ConstExpression l l Identity Identity) -> Doc ann)
-> [Identity (ConstExpression l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) (ZipList (Identity (ConstExpression l l Identity Identity))
-> [Identity (ConstExpression l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList (ZipList (Identity (ConstExpression l l Identity Identity))
 -> [Identity (ConstExpression l l Identity Identity)])
-> Maybe
     (ZipList (Identity (ConstExpression l l Identity Identity)))
-> Maybe [Identity (ConstExpression l l Identity Identity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ZipList (Identity (ConstExpression l l Identity Identity)))
parameters)
   pretty (If Identity (ConditionalBranch l l Identity Identity)
ifThen (ZipList [Identity (ConditionalBranch l l Identity Identity)]
elsifs) Maybe (Identity (StatementSequence l l Identity Identity))
fallback) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"IF" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConditionalBranch l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConditionalBranch l l Identity Identity)
ifThen
                                                        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (((Doc ann
"ELSIF" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann)
-> (Identity (ConditionalBranch l l Identity Identity) -> Doc ann)
-> Identity (ConditionalBranch l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (ConditionalBranch l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) (Identity (ConditionalBranch l l Identity Identity) -> Doc ann)
-> [Identity (ConditionalBranch l l Identity Identity)]
-> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (ConditionalBranch l l Identity Identity)]
elsifs)
                                                        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
x-> [Doc ann
"ELSE", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
x]) Maybe (Identity (StatementSequence l l Identity Identity))
fallback
                                                        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann
"END"])
   pretty (CaseStatement Identity (ConstExpression l l Identity Identity)
scrutinee ZipList (Identity (Case l l Identity Identity))
cases Maybe (Identity (StatementSequence l l Identity Identity))
fallback) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"CASE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
scrutinee Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF",
                                                           Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
forall a. Monoid a => a
mempty Doc ann
forall a. Monoid a => a
mempty Doc ann
"| "
                                                                  ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Identity (Case l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Case l l Identity Identity) -> Doc ann)
-> [Identity (Case l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Case l l Identity Identity))
-> [Identity (Case l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Case l l Identity Identity))
cases),
                                                           (Doc ann -> Doc ann) -> Maybe (Doc ann) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"ELSE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#>) (Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock (Identity (StatementSequence l l Identity Identity) -> Doc ann)
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Identity (StatementSequence l l Identity Identity))
fallback),
                                                           Doc ann
"END"]
   pretty (While Identity (ConstExpression l l Identity Identity)
condition Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"WHILE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
condition Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                         Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
                                         Doc ann
"END"]
   pretty (Repeat Identity (StatementSequence l l Identity Identity)
body Identity (ConstExpression l l Identity Identity)
condition) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"REPEAT",
                                          Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
                                          Doc ann
"UNTIL" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
condition]
   pretty (For Ident
index Identity (ConstExpression l l Identity Identity)
from Identity (ConstExpression l l Identity Identity)
to Maybe (Identity (ConstExpression l l Identity Identity))
by Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"FOR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
index Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
to
                                              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Doc ann -> Doc ann) -> Maybe (Doc ann) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"BY" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (ConstExpression l l Identity Identity) -> Doc ann)
-> Maybe (Identity (ConstExpression l l Identity Identity))
-> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Identity (ConstExpression l l Identity Identity))
by) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                              Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
                                              Doc ann
"END"]
   pretty (Loop Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"LOOP",
                              Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
                              Doc ann
"END"]
   pretty (With Identity (WithAlternative l l Identity Identity)
alternative (ZipList [Identity (WithAlternative l l Identity Identity)]
alternatives) Maybe (Identity (StatementSequence l l Identity Identity))
fallback) =
      Doc ann
"WITH" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
pipe (Identity (WithAlternative l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (WithAlternative l l Identity Identity) -> Doc ann)
-> [Identity (WithAlternative l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (WithAlternative l l Identity Identity)
alternative Identity (WithAlternative l l Identity Identity)
-> [Identity (WithAlternative l l Identity Identity)]
-> [Identity (WithAlternative l l Identity Identity)]
forall a. a -> [a] -> [a]
: [Identity (WithAlternative l l Identity Identity)]
alternatives) [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ 
            (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
x-> [Doc ann
"ELSE", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
x]) Maybe (Identity (StatementSequence l l Identity Identity))
fallback [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++
            [Doc ann
"END"])
   pretty Statement λ l Identity Identity
Exit = Doc ann
"EXIT"
   pretty (Return Maybe (Identity (ConstExpression l l Identity Identity))
result) = Doc ann
"RETURN" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Identity (ConstExpression l l Identity Identity) -> Doc ann)
-> Maybe (Identity (ConstExpression l l Identity Identity))
-> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (ConstExpression l l Identity Identity))
result

instance (Pretty (Abstract.Expression l l Identity Identity),
          Pretty (Abstract.StatementSequence l l Identity Identity)) =>
         Pretty (ConditionalBranch λ l Identity Identity) where
   pretty :: ConditionalBranch λ l Identity Identity -> Doc ann
pretty (ConditionalBranch Identity (Expression l l Identity Identity)
condition Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
condition Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"THEN",
                                                     Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body]
   
instance (Pretty (Abstract.CaseLabels l l Identity Identity),
          Pretty (Abstract.ConstExpression l l Identity Identity),
          Pretty (Abstract.StatementSequence l l Identity Identity)) => Pretty (Case λ l Identity Identity) where
   pretty :: Case λ l Identity Identity -> Doc ann
pretty (Case Identity (CaseLabels l l Identity Identity)
label ZipList (Identity (CaseLabels l l Identity Identity))
labels Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (Identity (CaseLabels l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (CaseLabels l l Identity Identity) -> Doc ann)
-> [Identity (CaseLabels l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (CaseLabels l l Identity Identity)
label Identity (CaseLabels l l Identity Identity)
-> [Identity (CaseLabels l l Identity Identity)]
-> [Identity (CaseLabels l l Identity Identity)]
forall a. a -> [a] -> [a]
: ZipList (Identity (CaseLabels l l Identity Identity))
-> [Identity (CaseLabels l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (CaseLabels l l Identity Identity))
labels)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon,
                                     Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body]
   
instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.StatementSequence l l Identity Identity)) =>
         Pretty (WithAlternative λ l Identity Identity) where
   pretty :: WithAlternative λ l Identity Identity -> Doc ann
pretty (WithAlternative QualIdent l
name QualIdent l
t Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                                Identity (StatementSequence l l Identity Identity) -> Doc ann
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body]

instance Pretty (Abstract.ConstExpression l l Identity Identity) => Pretty (CaseLabels λ l Identity Identity) where
   pretty :: CaseLabels λ l Identity Identity -> Doc ann
pretty (SingleLabel Identity (ConstExpression l l Identity Identity)
expression) = Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
expression
   pretty (LabelRange Identity (ConstExpression l l Identity Identity)
from Identity (ConstExpression l l Identity Identity)
to) = Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
to

prettyBlock :: Pretty (Abstract.StatementSequence l l Identity Identity) =>
               Identity (Abstract.StatementSequence l l Identity Identity) -> Doc ann
prettyBlock :: Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock (Identity StatementSequence l l Identity Identity
statements) = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (StatementSequence l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty StatementSequence l l Identity Identity
statements)

Doc ann
a <#> :: Doc ann -> Doc ann -> Doc ann
<#> Doc ann
b = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
a, Doc ann
b]