{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, OverloadedStrings, ScopedTypeVariables,
             TypeApplications, TypeFamilies, UndecidableInstances #-}

-- | This module exports the instances of the 'Pretty' type class necessary for printing of an ISO Modula-2 abstract
-- syntax tree.

module Language.Modula2.ISO.Pretty () where

import Control.Applicative (ZipList(ZipList, getZipList))
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity(..))
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty((:|)), fromList, toList)
import qualified Data.Text as Text
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)

import qualified Language.Oberon.Abstract
import qualified Language.Oberon.AST
import qualified Language.Modula2.Abstract as Abstract
import qualified Language.Modula2.ISO.Abstract as ISO.Abstract
import Language.Modula2.ISO.AST
import Language.Oberon.Pretty (Precedence(Precedence))
import Language.Modula2.Pretty ()
import qualified Language.Modula2.AST as Report

instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
          Pretty (Abstract.Export l), Pretty (Abstract.Import 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 False Language l Identity Identity) where
   pretty :: forall ann.
Declaration 'False Language l Identity Identity -> Doc ann
pretty (ProcedureDefinition Identity (ProcedureHeading l l Identity Identity)
heading) = 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
   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 (OpaqueTypeDeclaration IdentDef l
ident) = Doc ann
"TYPE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident 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 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)
varType forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi

instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
          Pretty (Abstract.Export l), Pretty (Abstract.Import l),
          Pretty (ISO.Abstract.AddressedIdent l l Identity Identity),
          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 True Language l Identity Identity) where
   pretty :: forall ann.
Declaration 'True Language l Identity Identity -> Doc ann
pretty (AddressedVariableDeclaration Identity (AddressedIdent l l Identity Identity)
var ZipList (Identity (AddressedIdent l l Identity Identity))
vars 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
<$> (Identity (AddressedIdent l l Identity Identity)
var forall a. a -> [a] -> [a]
: forall a. ZipList a -> [a]
getZipList ZipList (Identity (AddressedIdent l l Identity Identity))
vars)) 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 (ForwardProcedureDeclaration Identity (ProcedureHeading l l Identity Identity)
heading) = 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. Semigroup a => a -> a -> a
<> Doc ann
"FORWARD" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
   pretty (ModuleDeclaration Ident
name Maybe (Identity (Expression l l Identity Identity))
priority [Import l]
imports Maybe (Export l)
export 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 b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (Identity (Expression l l Identity Identity))
priority forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
       forall ann. [Doc ann] -> Doc ann
vsep (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import l]
imports),
       forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Export l)
export,
       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
<> forall ann. Doc ann
semi]
   pretty Declaration 'True Language l Identity Identity
dec = forall {k1} {k2} {k3} {b1} {f :: k1 -> k2 -> k3 -> *} {a :: k1}
       {b2 :: k2} {c :: k3}.
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Declaration l l'' f' f -> Declaration l' l'' f' f
Abstract.coDeclaration @Language @(Abstract.WirthySubsetOf Report.Language) Declaration 'True Language l Identity Identity
dec)

instance Pretty (Abstract.ConstExpression l l Identity Identity) => Pretty (AddressedIdent l l Identity Identity) where
   pretty :: forall ann. AddressedIdent l l Identity Identity -> Doc ann
pretty (AddressedIdent Ident
name Identity (ConstExpression l l Identity Identity)
address) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
address)
   pretty (UnaddressedIdent Ident
name) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name

instance (Pretty (Abstract.IdentDef l), 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 Language l Identity Identity) where
   pretty :: forall ann. Type Language l Identity Identity -> Doc ann
pretty (ArrayType ZipList (Identity (Type l l Identity Identity))
dimensions Identity (Type l l Identity Identity)
itemType) =
      Doc ann
"ARRAY" 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 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 (Type 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 (EnumerationType IdentList l
values) = Doc ann
"(" 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
comma forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList 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
<$> IdentList l
values) forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
   pretty (SubrangeType Maybe (BaseType l)
enumType Identity (ConstExpression l l Identity Identity)
min Identity (ConstExpression l l Identity Identity)
max) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a ann. Pretty a => a -> Doc ann
pretty Maybe (BaseType l)
enumType 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 Identity (ConstExpression l l Identity Identity)
min 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)
max forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
   pretty (SetType Identity (Type l l Identity Identity)
memberType) = Doc ann
"SET" 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)
memberType
   pretty (PackedSetType Identity (Type l l Identity Identity)
memberType) = Doc ann
"PACKED" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"SET" 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)
memberType
   pretty (RecordType ZipList (Identity (FieldList l l Identity Identity))
fields) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"RECORD",
                                       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 (ProcedureType Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {ann} {ann}. Doc ann -> Doc ann
adjust (forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters)
      where adjust :: Doc ann -> Doc ann
adjust = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident -> Ident -> Ident
Text.replace Ident
" : " Ident
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident -> Ident -> Ident
Text.replace Ident
";" Ident
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. SimpleDocStream ann -> Ident
renderStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> SimpleDocStream ann
layoutCompact
   pretty Type Language l Identity Identity
ty = forall {k1} {k2} {k3} {b1} {f :: k1 -> k2 -> k3 -> *} {a :: k1}
       {b2 :: k2} {c :: k3}.
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Type l l'' f' f -> Type l' l'' f' f
Abstract.coType @Language @(Abstract.WirthySubsetOf Report.Language) Type Language l Identity Identity
ty)

instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.QualIdent l), Pretty (Abstract.Type l l Identity Identity),
          Pretty (Abstract.Value l l Identity Identity),
          Pretty (Abstract.FieldList l l Identity Identity), Pretty (Abstract.Variant l l Identity Identity)) =>
         Pretty (Report.FieldList Language l Identity Identity) where
   pretty :: forall ann. FieldList Language l Identity Identity -> Doc ann
pretty FieldList Language l Identity Identity
fl = forall a ann. Pretty a => a -> Doc ann
pretty (coerce :: forall a b. Coercible a b => a -> b
coerce FieldList Language l Identity Identity
fl :: Report.FieldList Report.Language l Identity Identity)

instance (Pretty (Abstract.CaseLabels l l Identity Identity), Pretty (Abstract.FieldList l l Identity Identity)) =>
         Pretty (Variant λ l Identity Identity) where
   pretty :: forall ann. Variant λ l Identity Identity -> Doc ann
pretty Variant λ l Identity Identity
EmptyVariant = forall a. Monoid a => a
mempty
   pretty (Variant Identity (CaseLabels l l Identity Identity)
label ZipList (Identity (CaseLabels l l Identity Identity))
labels ZipList (Identity (FieldList l l Identity Identity))
fields) = forall a ann. Pretty a => a -> Doc ann
pretty (forall λ l (f' :: * -> *) (f :: * -> *).
f (CaseLabels l l f' f')
-> ZipList (f (CaseLabels l l f' f'))
-> ZipList (f (FieldList l l f' f'))
-> Variant λ l f' f
Report.Variant Identity (CaseLabels l l Identity Identity)
label ZipList (Identity (CaseLabels l l Identity Identity))
labels ZipList (Identity (FieldList l l Identity Identity))
fields)

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 {a} {ann}. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
body)
   pretty (ExceptionHandlingBlock ZipList (Identity (Declaration l l Identity Identity))
declarations Maybe (Identity (StatementSequence l l Identity Identity))
body Maybe (Identity (StatementSequence l l Identity Identity))
except Maybe (Identity (StatementSequence l l Identity Identity))
finally) =
      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 {a} {ann}. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
body
            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
"EXCEPT", forall {a} {ann}. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
except
            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
"FINALLY", forall {a} {ann}. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
finally)

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 (Language.Oberon.Abstract.WithAlternative l l Identity Identity),
          Pretty (Abstract.StatementSequence l l Identity Identity)) =>
         Pretty (Statement Language l Identity Identity) where
   prettyList :: forall ann. [Statement Language l Identity Identity] -> Doc ann
prettyList [Statement Language l Identity Identity]
l = forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> [Doc ann]
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 Language l Identity Identity]
l)
      where dropEmptyTail :: [Doc ann] -> [Doc ann]
dropEmptyTail
               | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Statement Language l Identity Identity]
l), Statement Language l Identity Identity
EmptyStatement <- forall a. [a] -> a
last [Statement Language l Identity Identity]
l = forall a. [a] -> [a]
init
               | Bool
otherwise = forall a. a -> a
id
   pretty :: forall ann. Statement Language l Identity Identity -> Doc ann
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 {a} {ann}. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
body,
                                              Doc ann
"END"]
   pretty (With Identity (Designator l l Identity Identity)
designator Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"WITH" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
designator forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                         forall {a} {ann}. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
body,
                                         Doc ann
"END"]
   pretty Statement Language l Identity Identity
RetryStatement = Doc ann
"RETRY"
   pretty Statement Language l Identity Identity
stat = forall {k1} {k2} {k3} {b1} {f :: k1 -> k2 -> k3 -> *} {a :: k1}
       {b2 :: k2} {c :: k3}.
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Statement l l'' f' f -> Statement l' l'' f' f
Abstract.coStatement @Language @(Abstract.WirthySubsetOf Report.Language) Statement Language l Identity Identity
stat)

instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
          Pretty (Abstract.Expression l l Identity Identity),
          Pretty (Abstract.Value l l Identity Identity),
          Pretty (Abstract.Element l l Identity Identity),
          Pretty (ISO.Abstract.Item l l Identity Identity),
          Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.QualIdent l)) => Pretty (Expression Language l Identity Identity) where
   pretty :: forall ann. Expression Language l Identity Identity -> Doc ann
pretty Expression Language l Identity Identity
e = forall a ann. Pretty a => a -> Doc ann
pretty (forall e. Int -> e -> Precedence e
Precedence Int
0 Expression Language l Identity Identity
e)

instance Pretty (Abstract.Value l l Identity Identity) => Pretty (Report.Value Language l Identity Identity) where
   pretty :: forall ann. Value Language l Identity Identity -> Doc ann
pretty Value Language l Identity Identity
v = forall {k1} {k2} {k3} {b1} {f :: k1 -> k2 -> k3 -> *} {a :: k1}
       {b2 :: k2} {c :: k3}.
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Value l l'' f' f -> Value l' l'' f' f
Abstract.coValue @Language @(Abstract.WirthySubsetOf Report.Language) Value Language l Identity Identity
v)

instance (Pretty (Abstract.Expression l l Identity Identity)) => Pretty (Item Language l Identity Identity) where
   pretty :: forall ann. Item Language l Identity Identity -> Doc ann
pretty (Single Identity (Expression l l Identity Identity)
e) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
e
   pretty (Repeated Identity (Expression l l Identity Identity)
e Identity (Expression l l Identity Identity)
count) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"BY" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
count

instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
          Pretty (Abstract.Expression l l Identity Identity),
          Pretty (Abstract.Value l l Identity Identity),
          Pretty (Abstract.Element l l Identity Identity),
          Pretty (ISO.Abstract.Item l l Identity Identity),
          Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.QualIdent l)) =>
         Pretty (Precedence (Expression Language l Identity Identity)) where
   pretty :: forall ann.
Precedence (Expression Language l Identity Identity) -> Doc ann
pretty (Precedence Int
p e :: Expression Language l Identity Identity
e@(Remainder 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 a ann. Pretty a => a -> Doc ann
pretty (forall e. Int -> e -> Precedence e
Precedence Int
4 forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity Identity (Expression l l Identity Identity)
left) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"REM" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall e. Int -> e -> Precedence e
Precedence Int
4 forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity Identity (Expression l l Identity Identity)
right)
      | Bool
otherwise = forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty Expression Language l Identity Identity
e)
   pretty (Precedence Int
_ (Array Maybe (QualIdent l)
itemType [Identity (Item l l Identity Identity)]
items)) =
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a ann. Pretty a => a -> Doc ann
pretty Maybe (QualIdent l)
itemType forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (Item l l Identity Identity)]
items)
   pretty (Precedence Int
_ (Record Maybe (QualIdent l)
recordType [Identity (Expression l l Identity Identity)]
fields)) =
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a ann. Pretty a => a -> Doc ann
pretty Maybe (QualIdent l)
recordType forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (Expression l l Identity Identity)]
fields)
   pretty (Precedence Int
_ (Set Maybe (QualIdent l)
setType ZipList (Identity (Element l l Identity Identity))
elements)) =
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a ann. Pretty a => a -> Doc ann
pretty Maybe (QualIdent l)
setType forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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 (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
p Expression Language l Identity Identity
e) =
      forall {k1} {k2} {k3} {b1} {f :: k1 -> k2 -> k3 -> *} {a :: k1}
       {b2 :: k2} {c :: k3}.
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 forall a. Monoid a => a
mempty (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Int -> e -> Precedence e
Precedence Int
p) (forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Expression l l'' f' f -> Expression l' l'' f' f
Abstract.coExpression @Language @(Abstract.WirthySubsetOf Report.Language) Expression Language l Identity Identity
e)

instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.Expression l l Identity Identity)) =>
         Pretty (Report.Designator Language l Identity Identity) where
   pretty :: forall ann. Designator Language l Identity Identity -> Doc ann
pretty Designator Language l Identity Identity
d = forall {k1} {k2} {k3} {b1} {f :: k1 -> k2 -> k3 -> *} {a :: k1}
       {b2 :: k2} {c :: k3}.
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Designator l l'' f' f -> Designator l' l'' f' f
Abstract.coDesignator @Language @(Abstract.WirthySubsetOf Report.Language) Designator Language l Identity Identity
d)

-- not used at run-time
instance Language.Oberon.Abstract.Oberon Language where
   type WithAlternative Language = Language.Oberon.AST.WithAlternative Language

prettyBody :: Identity a -> Doc ann
prettyBody (Identity a
statements) = forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (forall a ann. Pretty a => a -> Doc ann
pretty a
statements)