{-# 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 :: forall ann. Module λ l Identity Identity -> Doc ann
pretty (Module Ident
name [Import l]
imports Identity (Block l l Identity Identity)
body) =
      forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
      [Doc ann
"MODULE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
       if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import l]
imports then forall a. Monoid a => a
mempty
       else Doc ann
"IMPORT" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
fillSep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall {a} {a} {ann}.
(Pretty a, Pretty a) =>
(Maybe a, a) -> Doc ann
prettyImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import l]
imports)) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
       forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
       Doc ann
"END" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line]
      where prettyImport :: (Maybe a, a) -> Doc ann
prettyImport (Maybe a
Nothing, a
mod) = forall a ann. Pretty a => a -> Doc ann
pretty a
mod
            prettyImport (Just a
inner, a
mod) = forall a ann. Pretty a => a -> Doc ann
pretty a
inner forall a. Semigroup a => a -> a -> a
<> Doc ann
":=" forall ann. Doc ann -> Doc ann -> 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 :: forall ann. Declaration λ l Identity Identity -> Doc ann
pretty (ConstantDeclaration IdentDef l
ident (Identity Expression l l Identity Identity
expr)) = Doc ann
"CONST" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Expression l l Identity Identity
expr forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
   pretty (TypeDeclaration IdentDef l
ident Identity (Type l l Identity Identity)
typeDef) = Doc ann
"TYPE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
typeDef forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
   pretty (VariableDeclaration IdentList l
idents Identity (Type l l Identity Identity)
varType) =
      Doc ann
"VAR" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList IdentList l
idents) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
varType forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
   pretty (ProcedureDeclaration Identity (ProcedureHeading l l Identity Identity)
heading Identity (Block l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall a ann. Pretty a => a -> Doc ann
pretty Identity (ProcedureHeading l l Identity Identity)
heading forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
                                                      forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
                                                      Doc ann
"END" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' (f' :: * -> *) (f :: * -> *).
(Nameable l, Nameable l') =>
ProcedureHeading l l' f' f -> Ident
Abstract.getProcedureName forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity Identity (ProcedureHeading l l Identity Identity)
heading)
                                                      forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi]
   pretty (ForwardDeclaration IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"^" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi

instance Pretty (IdentDef l) where
   pretty :: forall ann. IdentDef l -> Doc ann
pretty (IdentDef Ident
name AccessMode
Exported) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> Doc ann
"*"
   pretty (IdentDef Ident
name AccessMode
ReadOnly) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> Doc ann
"-"
   pretty (IdentDef Ident
name AccessMode
PrivateOnly) = 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 :: forall ann. Expression λ l Identity Identity -> Doc ann
pretty Expression λ l Identity Identity
e = forall a ann. Pretty a => a -> Doc ann
pretty (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 :: forall ann.
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)) = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty RelOp
op forall ann. Doc ann -> Doc ann -> 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)) = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"IS" forall ann. Doc ann -> Doc ann -> 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 forall a. Ord a => a -> a -> Bool
< Int
2 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"+" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
< Int
2 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"-" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
< Int
2 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OR" forall ann. Doc ann -> Doc ann -> 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 forall a. Ord a => a -> a -> Bool
< Int
3 = Doc ann
"+" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
< Int
3 = Doc ann
"-" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"*" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"/" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DIV" forall ann. Doc ann -> Doc ann -> 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 forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"MOD" forall ann. Doc ann -> Doc ann -> 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 forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"&" forall ann. Doc ann -> Doc ann -> 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)) = forall ann. Doc ann -> Doc ann
braces (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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))) = 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)) =
      forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
fun forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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))) = 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 forall a. Ord a => a -> a -> Bool
< Int
5 = Doc ann
"~" forall a. Semigroup a => a -> a -> a
<> 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) = forall ann. Doc ann -> Doc ann
parens (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) = forall a ann. Pretty a => a -> Doc ann
pretty (forall e. Int -> e -> Precedence e
Precedence Int
p e
e)

instance Pretty RelOp where
   pretty :: forall ann. 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 :: forall ann. Element λ l Identity Identity -> Doc ann
pretty (Element Identity (Expression l l Identity Identity)
e) = 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) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
from forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." forall ann. Doc ann -> Doc ann -> 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 :: forall ann. 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) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
n
   pretty (Real Double
r) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Double
r)
   pretty (CharCode Int
c) = Doc ann
"0" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. (Integral a, Show a) => a -> ShowS
showHex Int
c [Char]
"") forall a. Semigroup a => a -> a -> a
<> Doc ann
"X"
   pretty (String Ident
s)
      | (Char -> Bool) -> Ident -> Bool
Text.any (forall a. Eq a => a -> a -> Bool
== Char
'"') Ident
s = forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Ident
s)
      | Bool
otherwise = forall ann. Doc ann -> Doc ann
dquotes (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) = 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 :: forall ann. Designator λ l Identity Identity -> Doc ann
pretty (Variable QualIdent l
q) = forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
q
   pretty (Field Identity (Designator l l Identity Identity)
record Ident
name) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
record forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
dot forall a. Semigroup a => a -> a -> a
<> 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) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
array forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma
                                                                  forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (Expression l l Identity Identity)
index forall a. a -> [a] -> [a]
: 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) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
scrutinee forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
typeName)
   pretty (Dereference Identity (Designator l l Identity Identity)
pointer) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
pointer 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 :: forall ann. Type λ l Identity Identity -> Doc ann
pretty (TypeReference BaseType l
q) = 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) =
      forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
"ARRAY" forall a. a -> [a] -> [a]
: forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (ConstExpression l l Identity Identity))
dimensions)) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF" forall ann. Doc ann -> Doc ann -> 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) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"RECORD" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (BaseType l)
baseType,
                                               forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" forall ann. Doc ann -> Doc ann -> 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" forall ann. Doc ann -> Doc ann -> 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 :: forall ann. QualIdent l -> Doc ann
pretty (QualIdent Ident
moduleName Ident
memberName) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
moduleName forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Ident
memberName
   pretty (NonQualIdent Ident
localName) = 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 :: forall ann. FieldList λ l Identity Identity -> Doc ann
pretty (FieldList IdentList l
names Identity (Type l l Identity Identity)
t) = forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList IdentList l
names) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> 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 :: forall ann. ProcedureHeading λ l Identity Identity -> Doc ann
pretty (ProcedureHeading Bool
indirect IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) =
      Doc ann
"PROCEDURE" forall a. Semigroup a => a -> a -> a
<> (if Bool
indirect then Doc ann
"* " else forall ann. Doc ann
space) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall a. Semigroup a => a -> a -> a
<> 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" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space 
      forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens ((if Bool
var then Doc ann
"VAR " else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Ident
receiverName forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
receiverType)
      forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> (if Bool
indirect then Doc ann
"* " else forall ann. Doc ann
space) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall a. Semigroup a => a -> a -> a
<> 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 :: forall ann. FormalParameters λ l Identity Identity -> Doc ann
pretty (FormalParameters ZipList (Identity (FPSection l l Identity Identity))
sections Maybe (ReturnType l)
result) =
      forall ann. Doc ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (FPSection l l Identity Identity))
sections) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rparen forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (forall a ann. Pretty a => a -> Doc ann
pretty 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 :: forall ann. 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" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
names) forall ann. Doc ann -> Doc ann -> Doc ann
<+> (forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> 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 :: forall ann. Block λ l Identity Identity -> Doc ann
pretty (Block ZipList (Identity (Declaration l l Identity Identity))
declarations Maybe (Identity (StatementSequence l l Identity Identity))
body) =
      forall ann. [Doc ann] -> Doc ann
vsep ((forall ann. Int -> Doc ann -> Doc ann
indent Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Declaration l l Identity Identity))
declarations)
            forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"BEGIN", 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 :: forall ann. StatementSequence λ l Identity Identity -> Doc ann
pretty (StatementSequence ZipList (Identity (Statement l l Identity Identity))
statements) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall ann. [Statement λ l Identity Identity] -> Doc ann
prettyList [Statement λ l Identity Identity]
l = forall ann. [Doc ann] -> Doc ann
vsep (forall {a}. [a] -> [a]
dropEmptyTail forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Statement λ l Identity Identity]
l), Statement λ l Identity Identity
EmptyStatement <- forall a. [a] -> a
last [Statement λ l Identity Identity]
l = forall {a}. [a] -> [a]
init
               | Bool
otherwise = forall a. a -> a
id
   pretty :: forall ann. Statement λ l Identity Identity -> Doc ann
pretty Statement λ l Identity Identity
EmptyStatement = forall a. Monoid a => a
mempty
   pretty (Assignment (Identity Designator l l Identity Identity
destination) Identity (ConstExpression l l Identity Identity)
expression) = forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
destination forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" forall ann. Doc ann -> Doc ann -> 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) =
      forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
procedure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) (forall a. ZipList a -> [a]
getZipList 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) = forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"IF" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConditionalBranch l l Identity Identity)
ifThen
                                                        forall a. a -> [a] -> [a]
: (((Doc ann
"ELSIF" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (ConditionalBranch l l Identity Identity)]
elsifs)
                                                        forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
x-> [Doc ann
"ELSE", 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
                                                        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) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"CASE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
scrutinee forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF",
                                                           forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Doc ann
"| "
                                                                  forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Case l l Identity Identity))
cases),
                                                           forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"ELSE" forall ann. Doc ann -> Doc ann -> Doc ann
<#>) (forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock 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) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"WHILE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
condition forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                         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) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"REPEAT",
                                          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" forall ann. Doc ann -> Doc ann -> 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) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"FOR" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
index forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
to
                                              forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"BY" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Identity (ConstExpression l l Identity Identity))
by) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                              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) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"LOOP",
                              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" forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      forall ann. [Doc ann] -> Doc ann
vsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
pipe (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (WithAlternative l l Identity Identity)
alternative forall a. a -> [a] -> [a]
: [Identity (WithAlternative l l Identity Identity)]
alternatives) forall a. [a] -> [a] -> [a]
++ 
            forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
x-> [Doc ann
"ELSE", 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 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" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap 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 :: forall ann. ConditionalBranch λ l Identity Identity -> Doc ann
pretty (ConditionalBranch Identity (Expression l l Identity Identity)
condition Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
condition forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"THEN",
                                                     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 :: forall ann. 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) = forall ann. [Doc ann] -> Doc ann
vsep [forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (CaseLabels l l Identity Identity)
label forall a. a -> [a] -> [a]
: forall a. ZipList a -> [a]
getZipList ZipList (Identity (CaseLabels l l Identity Identity))
labels)) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon,
                                     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 :: forall ann. WithAlternative λ l Identity Identity -> Doc ann
pretty (WithAlternative QualIdent l
name QualIdent l
t Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
t forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                                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 :: forall ann. CaseLabels λ l Identity Identity -> Doc ann
pretty (SingleLabel Identity (ConstExpression l l Identity Identity)
expression) = 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) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." forall ann. Doc ann -> Doc ann -> 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 :: 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) = forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (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 = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
a, Doc ann
b]