{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, UndecidableInstances #-}
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]