{- |
Module      :  ./HasCASL/PrintAs.hs
Description :  print the abstract syntax so that it can be re-parsed
Copyright   :  (c) Christian Maeder and Uni Bremen 2003
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  experimental
Portability :  portable

printing data types of the abstract syntax
-}

module HasCASL.PrintAs where

import HasCASL.As
import HasCASL.AsUtils
import HasCASL.FoldTerm
import HasCASL.Builtin

import Common.Id
import Common.Keywords
import Common.DocUtils
import Common.Doc
import Common.AS_Annotation

import qualified Data.Set as Set
import Data.List

-- | short cut for: if b then empty else d
noPrint :: Bool -> Doc -> Doc
noPrint :: Bool -> Doc -> Doc
noPrint b :: Bool
b d :: Doc
d = if Bool
b then Doc
empty else Doc
d

noNullPrint :: [a] -> Doc -> Doc
noNullPrint :: [a] -> Doc -> Doc
noNullPrint = Bool -> Doc -> Doc
noPrint (Bool -> Doc -> Doc) -> ([a] -> Bool) -> [a] -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

semiDs :: Pretty a => [a] -> Doc
semiDs :: [a] -> Doc
semiDs = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty

semiAnnoted :: Pretty a => [Annoted a] -> Doc
semiAnnoted :: [Annoted a] -> Doc
semiAnnoted = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Annoted a] -> [Doc]) -> [Annoted a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annoted a -> Doc) -> [Annoted a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Doc) -> Bool -> Annoted a -> Doc
forall a. (a -> Doc) -> Bool -> Annoted a -> Doc
printSemiAnno a -> Doc
forall a. Pretty a => a -> Doc
pretty Bool
True)

instance Pretty Variance where
    pretty :: Variance -> Doc
pretty = Token -> Doc
sidDoc (Token -> Doc) -> (Variance -> Token) -> Variance -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
mkSimpleId (String -> Token) -> (Variance -> String) -> Variance -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variance -> String
forall a. Show a => a -> String
show

instance Pretty a => Pretty (AnyKind a) where
    pretty :: AnyKind a -> Doc
pretty knd :: AnyKind a
knd = case AnyKind a
knd of
        ClassKind ci :: a
ci -> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
ci
        FunKind v :: Variance
v k1 :: AnyKind a
k1 k2 :: AnyKind a
k2 _ -> [Doc] -> Doc
fsep
            [ Variance -> Doc
forall a. Pretty a => a -> Doc
pretty Variance
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (case AnyKind a
k1 of
                FunKind {} -> Doc -> Doc
parens
                _ -> Doc -> Doc
forall a. a -> a
id) (AnyKind a -> Doc
forall a. Pretty a => a -> Doc
pretty AnyKind a
k1)
            , Doc
funArrow, AnyKind a -> Doc
forall a. Pretty a => a -> Doc
pretty AnyKind a
k2]

varOfTypeArg :: TypeArg -> Id
varOfTypeArg :: TypeArg -> Id
varOfTypeArg (TypeArg i :: Id
i _ _ _ _ _ _) = Id
i

instance Pretty TypePattern where
    pretty :: TypePattern -> Doc
pretty tp :: TypePattern
tp = case TypePattern
tp of
        TypePattern name :: Id
name@(Id ts :: [Token]
ts cs :: [Id]
cs _) args :: [TypeArg]
args _ ->
          let ds :: [Doc]
ds = (TypeArg -> Doc) -> [TypeArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Id -> Doc
forall a. Pretty a => a -> Doc
pretty (Id -> Doc) -> (TypeArg -> Id) -> TypeArg -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeArg -> Id
varOfTypeArg) [TypeArg]
args in
            if Id -> Int
placeCount Id
name Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [TypeArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeArg]
args then
                let (ras :: [Doc]
ras, dts :: [Doc]
dts) = ([Doc] -> Token -> ([Doc], Doc))
-> [Doc] -> [Token] -> ([Doc], [Doc])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL ( \ l :: [Doc]
l t :: Token
t -> if Token -> Bool
isPlace Token
t then
                          case [Doc]
l of
                            x :: Doc
x : r :: [Doc]
r -> ([Doc]
r, Doc
x)
                            _ -> String -> ([Doc], Doc)
forall a. HasCallStack => String -> a
error "Pretty TypePattern"
                          else ([Doc]
l, Token -> Doc
printTypeToken Token
t)) [Doc]
ds [Token]
ts
                in [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dts [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (if [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs then [] else
                        [Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
printTypeId [Id]
cs])
                       [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ras
            else Id -> Doc
printTypeId Id
name Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep [Doc]
ds
        TypePatternToken t :: Token
t -> Token -> Doc
printTypeToken Token
t
        MixfixTypePattern ts :: [TypePattern]
ts -> [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TypePattern -> Doc) -> [TypePattern] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypePattern -> Doc
forall a. Pretty a => a -> Doc
pretty [TypePattern]
ts
        BracketTypePattern k :: BracketKind
k l :: [TypePattern]
l _ -> BracketKind -> Doc -> Doc
bracket BracketKind
k (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [TypePattern] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [TypePattern]
l
        TypePatternArg t :: TypeArg
t _ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TypeArg -> Doc
forall a. Pretty a => a -> Doc
pretty TypeArg
t

-- | put proper brackets around a document
bracket :: BracketKind -> Doc -> Doc
bracket :: BracketKind -> Doc -> Doc
bracket b :: BracketKind
b = case BracketKind
b of
    Parens -> Doc -> Doc
parens
    Squares -> Doc -> Doc
brackets
    Braces -> Doc -> Doc
specBraces
    NoBrackets -> Doc -> Doc
forall a. a -> a
id

-- | print a 'Kind' plus a preceding colon (or nothing)
printKind :: Kind -> Doc
printKind :: Kind -> Doc
printKind k :: Kind
k = Bool -> Doc -> Doc
noPrint (Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
universe) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Variance -> VarKind -> Doc
printVarKind Variance
NonVar (Kind -> VarKind
VarKind Kind
k)

-- | print the kind of a variable with its variance and a preceding colon
printVarKind :: Variance -> VarKind -> Doc
printVarKind :: Variance -> VarKind -> Doc
printVarKind e :: Variance
e vk :: VarKind
vk = case VarKind
vk of
    Downset t :: Type
t -> Doc
less Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t
    VarKind k :: Kind
k -> Doc
colon Doc -> Doc -> Doc
<+> Variance -> Doc
forall a. Pretty a => a -> Doc
pretty Variance
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Kind -> Doc
forall a. Pretty a => a -> Doc
pretty Kind
k
    MissingKind -> Doc
empty

data TypePrec = Outfix | Prefix | Lazyfix | ProdInfix | FunInfix | Absfix
    deriving (TypePrec -> TypePrec -> Bool
(TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool) -> Eq TypePrec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypePrec -> TypePrec -> Bool
$c/= :: TypePrec -> TypePrec -> Bool
== :: TypePrec -> TypePrec -> Bool
$c== :: TypePrec -> TypePrec -> Bool
Eq, Eq TypePrec
Eq TypePrec =>
(TypePrec -> TypePrec -> Ordering)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> TypePrec)
-> (TypePrec -> TypePrec -> TypePrec)
-> Ord TypePrec
TypePrec -> TypePrec -> Bool
TypePrec -> TypePrec -> Ordering
TypePrec -> TypePrec -> TypePrec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypePrec -> TypePrec -> TypePrec
$cmin :: TypePrec -> TypePrec -> TypePrec
max :: TypePrec -> TypePrec -> TypePrec
$cmax :: TypePrec -> TypePrec -> TypePrec
>= :: TypePrec -> TypePrec -> Bool
$c>= :: TypePrec -> TypePrec -> Bool
> :: TypePrec -> TypePrec -> Bool
$c> :: TypePrec -> TypePrec -> Bool
<= :: TypePrec -> TypePrec -> Bool
$c<= :: TypePrec -> TypePrec -> Bool
< :: TypePrec -> TypePrec -> Bool
$c< :: TypePrec -> TypePrec -> Bool
compare :: TypePrec -> TypePrec -> Ordering
$ccompare :: TypePrec -> TypePrec -> Ordering
$cp1Ord :: Eq TypePrec
Ord)

parenPrec :: TypePrec -> (TypePrec, Doc) -> Doc
parenPrec :: TypePrec -> (TypePrec, Doc) -> Doc
parenPrec p1 :: TypePrec
p1 (p2 :: TypePrec
p2, d :: Doc
d) = if TypePrec
p2 TypePrec -> TypePrec -> Bool
forall a. Ord a => a -> a -> Bool
< TypePrec
p1 then Doc
d else Doc -> Doc
parens Doc
d

printTypeToken :: Token -> Doc
printTypeToken :: Token -> Doc
printTypeToken t :: Token
t = let
  l :: [(String, Doc)]
l = ("*", Doc
cross) (String, Doc) -> [(String, Doc)] -> [(String, Doc)]
forall a. a -> [a] -> [a]
: ((Arrow, Doc) -> (String, Doc))
-> [(Arrow, Doc)] -> [(String, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map ( \ (a :: Arrow
a, d :: Doc
d) -> (Arrow -> String
forall a. Show a => a -> String
show Arrow
a, Doc
d) )
    [ (Arrow
FunArr, Doc
funArrow)
    , (Arrow
PFunArr, Doc
pfun)
    , (Arrow
ContFunArr, Doc
cfun)
    , (Arrow
PContFunArr, Doc
pcfun) ]
  in case String -> [(String, Doc)] -> Maybe Doc
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Token -> String
tokStr Token
t) [(String, Doc)]
l of
       Just d :: Doc
d -> Doc
d
       _ -> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
t

printTypeId :: Id -> Doc
printTypeId :: Id -> Doc
printTypeId (Id ts :: [Token]
ts cs :: [Id]
cs _) = let (toks :: [Token]
toks, pls :: [Token]
pls) = [Token] -> ([Token], [Token])
splitMixToken [Token]
ts in
   [Doc] -> Doc
fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Token -> Doc) -> [Token] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc
printTypeToken [Token]
toks
   [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (if [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs then [] else [Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
printTypeId [Id]
cs])
   [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Token -> Doc) -> [Token] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc
printTypeToken [Token]
pls

toMixType :: Type -> (TypePrec, Doc)
toMixType :: Type -> (TypePrec, Doc)
toMixType typ :: Type
typ = case Type
typ of
    TypeName name :: Id
name _ _ -> (TypePrec
Outfix, Id -> Doc
printTypeId Id
name)
    TypeToken tt :: Token
tt -> (TypePrec
Outfix, Token -> Doc
printTypeToken Token
tt)
    TypeAbs v :: TypeArg
v t :: Type
t _ ->
        (TypePrec
Absfix, [Doc] -> Doc
sep [ Doc
lambda Doc -> Doc -> Doc
<+> TypeArg -> Doc
forall a. Pretty a => a -> Doc
pretty TypeArg
v, Doc
bullet Doc -> Doc -> Doc
<+> (TypePrec, Doc) -> Doc
forall a b. (a, b) -> b
snd (Type -> (TypePrec, Doc)
toMixType Type
t)])
    ExpandedType t1 :: Type
t1 _ -> Type -> (TypePrec, Doc)
toMixType Type
t1 -- here we print the unexpanded type
    BracketType k :: BracketKind
k l :: [Type]
l _ ->
        (TypePrec
Outfix, BracketKind -> Doc -> Doc
bracket BracketKind
k (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((TypePrec, Doc) -> Doc
forall a b. (a, b) -> b
snd ((TypePrec, Doc) -> Doc)
-> (Type -> (TypePrec, Doc)) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (TypePrec, Doc)
toMixType) [Type]
l)
    KindedType t :: Type
t kind :: Set Kind
kind _ -> (TypePrec
Lazyfix, [Doc] -> Doc
sep
      [ TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
Lazyfix ((TypePrec, Doc) -> Doc) -> (TypePrec, Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ Type -> (TypePrec, Doc)
toMixType Type
t
      , Doc
colon Doc -> Doc -> Doc
<+> [Kind] -> Doc
forall a. Pretty a => [a] -> Doc
printList0 (Set Kind -> [Kind]
forall a. Set a -> [a]
Set.toList Set Kind
kind)])
    MixfixType ts :: [Type]
ts -> (TypePrec
Prefix, [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((TypePrec, Doc) -> Doc
forall a b. (a, b) -> b
snd ((TypePrec, Doc) -> Doc)
-> (Type -> (TypePrec, Doc)) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (TypePrec, Doc)
toMixType) [Type]
ts)
    TypeAppl t1 :: Type
t1 t2 :: Type
t2 -> let
        (topTy :: Type
topTy, tyArgs :: [Type]
tyArgs) = Bool -> Type -> (Type, [Type])
getTypeApplAux Bool
False Type
typ
        aArgs :: (TypePrec, Doc)
aArgs = (TypePrec
Prefix, [Doc] -> Doc
sep [ TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
ProdInfix ((TypePrec, Doc) -> Doc) -> (TypePrec, Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ Type -> (TypePrec, Doc)
toMixType Type
t1
                             , TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
Prefix ((TypePrec, Doc) -> Doc) -> (TypePrec, Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ Type -> (TypePrec, Doc)
toMixType Type
t2 ])
         in case Type
topTy of
      TypeName name :: Id
name@(Id ts :: [Token]
ts cs :: [Id]
cs _) _k :: RawKind
_k _i :: Int
_i ->
        case (Type -> (TypePrec, Doc)) -> [Type] -> [(TypePrec, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map Type -> (TypePrec, Doc)
toMixType [Type]
tyArgs of
          [dArg :: (TypePrec, Doc)
dArg] -> case [Token]
ts of
               [e :: Token
e] | Id
name Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
lazyTypeId ->
                   (TypePrec
Lazyfix, Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
e Doc -> Doc -> Doc
<+> TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
Lazyfix (TypePrec, Doc)
dArg)
               [e1 :: Token
e1, e2 :: Token
e2, e3 :: Token
e3] | Bool -> Bool
not (Token -> Bool
isPlace Token
e1) Bool -> Bool -> Bool
&& Token -> Bool
isPlace Token
e2
                              Bool -> Bool -> Bool
&& Bool -> Bool
not (Token -> Bool
isPlace Token
e3) Bool -> Bool -> Bool
&& [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs ->
                   (TypePrec
Outfix, [Doc] -> Doc
fsep [Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
e1, (TypePrec, Doc) -> Doc
forall a b. (a, b) -> b
snd (TypePrec, Doc)
dArg, Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
e3])
               _ -> (TypePrec, Doc)
aArgs
          [dArg1 :: (TypePrec, Doc)
dArg1, dArg2 :: (TypePrec, Doc)
dArg2] -> case [Token]
ts of
               [_, e2 :: Token
e2, _] | Id -> Bool
isInfix Id
name Bool -> Bool -> Bool
&& [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs ->
                  if Token -> String
tokStr Token
e2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
prodS then
                    (TypePrec
ProdInfix, [Doc] -> Doc
fsep
                     [ TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
ProdInfix (TypePrec, Doc)
dArg1
                     , Doc
cross, TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
ProdInfix (TypePrec, Doc)
dArg2])
                  else -- assume fun type
                  (TypePrec
FunInfix, [Doc] -> Doc
fsep
                   [ TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
FunInfix (TypePrec, Doc)
dArg1
                   , Token -> Doc
printTypeToken Token
e2, (TypePrec, Doc) -> Doc
forall a b. (a, b) -> b
snd (TypePrec, Doc)
dArg2])
               _ -> (TypePrec, Doc)
aArgs
          dArgs :: [(TypePrec, Doc)]
dArgs -> if Id -> Int -> Bool
isProductIdWithArgs Id
name (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tyArgs then
              (TypePrec
ProdInfix, [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
cross) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
               ((TypePrec, Doc) -> Doc) -> [(TypePrec, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TypePrec -> (TypePrec, Doc) -> Doc
parenPrec TypePrec
ProdInfix) [(TypePrec, Doc)]
dArgs) else (TypePrec, Doc)
aArgs
      _ -> (TypePrec, Doc)
aArgs

instance Pretty Type where
    pretty :: Type -> Doc
pretty = (TypePrec, Doc) -> Doc
forall a b. (a, b) -> b
snd ((TypePrec, Doc) -> Doc)
-> (Type -> (TypePrec, Doc)) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (TypePrec, Doc)
toMixType

printTypeScheme :: PolyId -> TypeScheme -> Doc
printTypeScheme :: PolyId -> TypeScheme -> Doc
printTypeScheme (PolyId _ tys :: [TypeArg]
tys _) (TypeScheme vs :: [TypeArg]
vs t :: Type
t _) =
    let tdoc :: Doc
tdoc = Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t in
    if [TypeArg] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeArg]
vs Bool -> Bool -> Bool
|| Bool -> Bool
not ([TypeArg] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeArg]
tys) then Doc
tdoc else
        [Doc] -> Doc
fsep [Doc
forallDoc, [TypeArg] -> Doc
forall a. Pretty a => [a] -> Doc
semiDs [TypeArg]
vs, Doc
bullet Doc -> Doc -> Doc
<+> Doc
tdoc]

-- no curried notation for bound variables
instance Pretty TypeScheme where
    pretty :: TypeScheme -> Doc
pretty = PolyId -> TypeScheme -> Doc
printTypeScheme (Id -> [TypeArg] -> Range -> PolyId
PolyId Id
applId [] Range
nullRange)

instance Pretty Partiality where
    pretty :: Partiality -> Doc
pretty p :: Partiality
p = case Partiality
p of
        Partial -> Doc
quMarkD
        Total -> Doc
empty

instance Pretty Quantifier where
    pretty :: Quantifier -> Doc
pretty q :: Quantifier
q = case Quantifier
q of
        Universal -> Doc
forallDoc
        Existential -> Doc
exists
        Unique -> Doc
unique

instance Pretty TypeQual where
    pretty :: TypeQual -> Doc
pretty q :: TypeQual
q = case TypeQual
q of
        OfType -> Doc
colon
        AsType -> String -> Doc
text String
asS
        InType -> Doc
inDoc
        Inferred -> Doc
colon

instance Pretty Term where
    pretty :: Term -> Doc
pretty = Term -> Doc
printTerm (Term -> Doc) -> (Term -> Term) -> Term -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Term
rmSomeTypes

isSimpleTerm :: Term -> Bool
isSimpleTerm :: Term -> Bool
isSimpleTerm trm :: Term
trm = case Term
trm of
    QualVar _ -> Bool
True
    QualOp {} -> Bool
True
    ResolvedMixTerm {} -> Bool
True
    ApplTerm {} -> Bool
True
    TupleTerm _ _ -> Bool
True
    TermToken _ -> Bool
True
    BracketTerm {} -> Bool
True
    _ -> Bool
False

-- | used only to produce CASL applications
isSimpleArgTerm :: Term -> Bool
isSimpleArgTerm :: Term -> Bool
isSimpleArgTerm trm :: Term
trm = case Term
trm of
    QualVar vd :: VarDecl
vd -> Bool -> Bool
not (VarDecl -> Bool
isPatVarDecl VarDecl
vd)
    QualOp {} -> Bool
True
    ResolvedMixTerm n :: Id
n _ l :: [Term]
l _ -> Id -> Int
placeCount Id
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
|| Bool -> Bool
not ([Term] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Term]
l)
    TupleTerm _ _ -> Bool
True
    BracketTerm {} -> Bool
True
    _ -> Bool
False

hasRightQuant :: Term -> Bool
hasRightQuant :: Term -> Bool
hasRightQuant t :: Term
t = case Term
t of
    QuantifiedTerm {} -> Bool
True
    LambdaTerm {} -> Bool
True
    CaseTerm {} -> Bool
True
    LetTerm Let _ _ _ -> Bool
True
    ResolvedMixTerm n :: Id
n _ ts :: [Term]
ts _ | Id -> Bool
endPlace Id
n Bool -> Bool -> Bool
&& Id -> Int
placeCount Id
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Term] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
ts
        -> Term -> Bool
hasRightQuant ([Term] -> Term
forall a. [a] -> a
last [Term]
ts)
    ApplTerm (ResolvedMixTerm n :: Id
n _ [] _) t2 :: Term
t2 _ | Id -> Bool
endPlace Id
n ->
        case Term
t2 of
          TupleTerm ts :: [Term]
ts _ | Id -> Int
placeCount Id
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Term] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
ts -> Term -> Bool
hasRightQuant ([Term] -> Term
forall a. [a] -> a
last [Term]
ts)
          _ -> Term -> Bool
hasRightQuant Term
t2
    ApplTerm _ t2 :: Term
t2 _ -> Term -> Bool
hasRightQuant Term
t2
    _ -> Bool
False

zipArgs :: Id -> [Term] -> [Doc] -> [Doc]
zipArgs :: Id -> [Term] -> [Doc] -> [Doc]
zipArgs n :: Id
n ts :: [Term]
ts ds :: [Doc]
ds = case ([Term]
ts, [Doc]
ds) of
    (t :: Term
t : r :: [Term]
r, d :: Doc
d : s :: [Doc]
s) -> let
        p :: Doc
p = Term -> Doc -> Doc
parenTermDoc Term
t Doc
d
        e :: Doc
e = if Term -> Bool
hasRightQuant Term
t then Doc -> Doc
parens Doc
d else Doc
p
        in if [Term] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Term]
r Bool -> Bool -> Bool
&& [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
s Bool -> Bool -> Bool
&& Id -> Bool
endPlace Id
n then
               [if Term -> Bool
hasRightQuant Term
t then Doc
d else Doc
p]
           else Doc
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Id -> [Term] -> [Doc] -> [Doc]
zipArgs Id
n [Term]
r [Doc]
s
    _ -> []

isPatVarDecl :: VarDecl -> Bool
isPatVarDecl :: VarDecl -> Bool
isPatVarDecl (VarDecl v :: Id
v ty :: Type
ty _ _) = case Type
ty of
           TypeName t :: Id
t _ _ -> Id -> Bool
isSimpleId Id
v Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "_v" (Id -> String
forall a. Show a => a -> String
show Id
t)
           _ -> Bool
False

parenTermDoc :: Term -> Doc -> Doc
parenTermDoc :: Term -> Doc -> Doc
parenTermDoc trm :: Term
trm = if Term -> Bool
isSimpleTerm Term
trm then Doc -> Doc
forall a. a -> a
id else Doc -> Doc
parens

printTermRec :: FoldRec Doc (Doc, Doc)
printTermRec :: FoldRec Doc (Doc, Doc)
printTermRec = FoldRec :: forall a b.
(Term -> VarDecl -> a)
-> (Term
    -> OpBrand
    -> PolyId
    -> TypeScheme
    -> [Type]
    -> InstKind
    -> Range
    -> a)
-> (Term -> a -> a -> Range -> a)
-> (Term -> [a] -> Range -> a)
-> (Term -> a -> TypeQual -> Type -> Range -> a)
-> (Term -> VarDecl -> a -> Range -> a)
-> (Term -> Quantifier -> [GenVarDecl] -> a -> Range -> a)
-> (Term -> [a] -> Partiality -> a -> Range -> a)
-> (Term -> a -> [b] -> Range -> a)
-> (Term -> LetBrand -> [b] -> a -> Range -> a)
-> (Term -> Id -> [Type] -> [a] -> Range -> a)
-> (Term -> Token -> a)
-> (Term -> TypeQual -> Type -> Range -> a)
-> (Term -> [a] -> a)
-> (Term -> BracketKind -> [a] -> Range -> a)
-> (ProgEq -> a -> a -> Range -> b)
-> FoldRec a b
FoldRec
    { foldQualVar :: Term -> VarDecl -> Doc
foldQualVar = \ _ vd :: VarDecl
vd@(VarDecl v :: Id
v _ _ _) ->
         if VarDecl -> Bool
isPatVarDecl VarDecl
vd then Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
v
         else Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
keyword String
varS Doc -> Doc -> Doc
<+> VarDecl -> Doc
forall a. Pretty a => a -> Doc
pretty VarDecl
vd
    , foldQualOp :: Term
-> OpBrand
-> PolyId
-> TypeScheme
-> [Type]
-> InstKind
-> Range
-> Doc
foldQualOp = \ _ br :: OpBrand
br n :: PolyId
n t :: TypeScheme
t tys :: [Type]
tys k :: InstKind
k _ ->
        (if [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys Bool -> Bool -> Bool
|| InstKind
k InstKind -> InstKind -> Bool
forall a. Eq a => a -> a -> Bool
== InstKind
Infer then Doc -> Doc
forall a. a -> a
id else
          (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets ([Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Type]
tys))) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
          Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [OpBrand -> Doc
forall a. Pretty a => a -> Doc
pretty OpBrand
br, PolyId -> Doc
forall a. Pretty a => a -> Doc
pretty PolyId
n, Doc
colon, PolyId -> TypeScheme -> Doc
printTypeScheme PolyId
n (TypeScheme -> Doc) -> TypeScheme -> Doc
forall a b. (a -> b) -> a -> b
$
                         if OpBrand -> Bool
isPred OpBrand
br then TypeScheme -> TypeScheme
unPredTypeScheme TypeScheme
t else TypeScheme
t]
    , foldResolvedMixTerm :: Term -> Id -> [Type] -> [Doc] -> Range -> Doc
foldResolvedMixTerm = \ rt :: Term
rt n :: Id
n@(Id toks :: [Token]
toks cs :: [Id]
cs ps :: Range
ps) tys :: [Type]
tys ts :: [Doc]
ts _ ->
          let pn :: Int
pn = Id -> Int
placeCount Id
n
              ResolvedMixTerm _ _ os :: [Term]
os _ = Term
rt
              ds :: [Doc]
ds = Id -> [Term] -> [Doc] -> [Doc]
zipArgs Id
n [Term]
os [Doc]
ts
          in if Int
pn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Doc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
ts Bool -> Bool -> Bool
|| [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
ts then
            if [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys then Id -> [Doc] -> Doc
idApplDoc Id
n [Doc]
ds
            else let (ftoks :: [Token]
ftoks, _) = [Token] -> ([Token], [Token])
splitMixToken [Token]
toks
                     fId :: Id
fId = [Token] -> [Id] -> Range -> Id
Id [Token]
ftoks [Id]
cs Range
ps
                     (fts :: [Doc]
fts, rts :: [Doc]
rts) = Int -> [Doc] -> ([Doc], [Doc])
forall a. Int -> [a] -> ([a], [a])
splitAt (Id -> Int
placeCount Id
fId) ([Doc] -> ([Doc], [Doc])) -> [Doc] -> ([Doc], [Doc])
forall a b. (a -> b) -> a -> b
$ if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
ts
                          then Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
pn (Doc -> [Doc]) -> Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
placeTok else [Doc]
ds
                 in [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Id -> [Doc] -> Doc
idApplDoc Id
fId [Doc]
fts Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets ([Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Type]
tys))
                    Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
rts
          else Id -> [Doc] -> Doc
idApplDoc Id
applId [Id -> Doc
idDoc Id
n, Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas [Doc]
ts]
    , foldApplTerm :: Term -> Doc -> Doc -> Range -> Doc
foldApplTerm = \ ot :: Term
ot t1 :: Doc
t1 t2 :: Doc
t2 _ ->
        case Term
ot of
          -- comment out the following two guards for CASL applications
          ApplTerm (ResolvedMixTerm n :: Id
n _ [] _) (TupleTerm ts :: [Term]
ts@(_ : _) _) _
              | Id -> Int
placeCount Id
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Term] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
ts ->
                  Id -> [Doc] -> Doc
idApplDoc Id
n (Id -> [Term] -> [Doc] -> [Doc]
zipArgs Id
n [Term]
ts ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Term -> Doc) -> [Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Doc
printTerm [Term]
ts)
          ApplTerm (ResolvedMixTerm n :: Id
n _ [] _) o2 :: Term
o2 _ | Id -> Int
placeCount Id
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
            -> Id -> [Doc] -> Doc
idApplDoc Id
n ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Id -> [Term] -> [Doc] -> [Doc]
zipArgs Id
n [Term
o2] [Doc
t2]
          ApplTerm o1 :: Term
o1 o2 :: Term
o2 _
            -> Id -> [Doc] -> Doc
idApplDoc Id
applId ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Id -> [Term] -> [Doc] -> [Doc]
zipArgs Id
applId [Term
o1, Term
o2] [Doc
t1, Doc
t2]
          _ -> String -> Doc
forall a. HasCallStack => String -> a
error "printTermRec.foldApplTerm"
     , foldTupleTerm :: Term -> [Doc] -> Range -> Doc
foldTupleTerm = \ _ ts :: [Doc]
ts _ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas [Doc]
ts
     , foldTypedTerm :: Term -> Doc -> TypeQual -> Type -> Range -> Doc
foldTypedTerm = \ ~(TypedTerm ot :: Term
ot _ _ _) t :: Doc
t q :: TypeQual
q typ :: Type
typ _ -> [Doc] -> Doc
fsep [(case Term
ot of
           TypedTerm {} | TypeQual -> [TypeQual] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem TypeQual
q [TypeQual
Inferred, TypeQual
OfType] -> Doc -> Doc
parens
           ApplTerm (ResolvedMixTerm n :: Id
n _ [] _) arg :: Term
arg _ ->
             let pn :: Int
pn = Id -> Int
placeCount Id
n in case Term
arg of
               TupleTerm ts :: [Term]
ts@(_ : _) _ | Int
pn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Term] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term]
ts -> Doc -> Doc
parens
               _ | Int
pn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| Term -> Bool
hasRightQuant Term
ot -> Doc -> Doc
parens
               _ -> Doc -> Doc
forall a. a -> a
id
           _ | Term -> Bool
hasRightQuant Term
ot -> Doc -> Doc
parens
           _ -> Doc -> Doc
forall a. a -> a
id) Doc
t, TypeQual -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQual
q, Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
typ]
     , foldQuantifiedTerm :: Term -> Quantifier -> [GenVarDecl] -> Doc -> Range -> Doc
foldQuantifiedTerm = \ _ q :: Quantifier
q vs :: [GenVarDecl]
vs t :: Doc
t _ ->
           [Doc] -> Doc
fsep [Quantifier -> Doc
forall a. Pretty a => a -> Doc
pretty Quantifier
q, [GenVarDecl] -> Doc
printGenVarDecls [GenVarDecl]
vs, Doc
bullet Doc -> Doc -> Doc
<+> Doc
t]
     , foldLambdaTerm :: Term -> [Doc] -> Partiality -> Doc -> Range -> Doc
foldLambdaTerm = \ ot :: Term
ot ps :: [Doc]
ps q :: Partiality
q t :: Doc
t _ ->
            let LambdaTerm ops :: [Term]
ops _ _ _ = Term
ot in
            [Doc] -> Doc
fsep [ Doc
lambda
                 , case [Term]
ops of
                      [p :: Term
p] -> case Term
p of
                          TupleTerm [] _ -> Doc
empty
                          QualVar vd :: VarDecl
vd@(VarDecl v :: Id
v ty :: Type
ty _ _) ->
                              Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
v Doc -> Doc -> Doc
<+> if VarDecl -> Bool
isPatVarDecl VarDecl
vd then Doc
empty
                                     else Type -> Doc
printVarDeclType Type
ty
                          _ -> [Doc] -> Doc
forall a. [a] -> a
head [Doc]
ps
                      _ -> if (Term -> Bool) -> [Term] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( \ p :: Term
p -> case Term
p of
                                QualVar vd :: VarDecl
vd -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ VarDecl -> Bool
isPatVarDecl VarDecl
vd
                                _ -> Bool
False) [Term]
ops
                           then [GenVarDecl] -> Doc
printGenVarDecls ([GenVarDecl] -> Doc) -> [GenVarDecl] -> Doc
forall a b. (a -> b) -> a -> b
$ (Term -> GenVarDecl) -> [Term] -> [GenVarDecl]
forall a b. (a -> b) -> [a] -> [b]
map
                                (\ pt :: Term
pt -> let QualVar vd :: VarDecl
vd = Term
pt in VarDecl -> GenVarDecl
GenVarDecl VarDecl
vd)
                                [Term]
ops
                           else [Doc] -> Doc
fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
parens [Doc]
ps
                 , (case Partiality
q of
                     Partial -> Doc
bullet
                     Total -> Doc
bullet Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
exMark) Doc -> Doc -> Doc
<+> Doc
t]
     , foldCaseTerm :: Term -> Doc -> [(Doc, Doc)] -> Range -> Doc
foldCaseTerm = \ _ t :: Doc
t es :: [(Doc, Doc)]
es _ ->
            [Doc] -> Doc
fsep [String -> Doc
text String
caseS, Doc
t, String -> Doc
text String
ofS,
                  [Doc] -> Doc
cat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
bar Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                       ((Doc, Doc) -> Doc) -> [(Doc, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> (Doc, Doc) -> Doc
printEq0 Doc
funArrow) [(Doc, Doc)]
es]
     , foldLetTerm :: Term -> LetBrand -> [(Doc, Doc)] -> Doc -> Range -> Doc
foldLetTerm = \ _ br :: LetBrand
br es :: [(Doc, Doc)]
es t :: Doc
t _ ->
            let des :: Doc
des = [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((Doc, Doc) -> Doc) -> [(Doc, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> (Doc, Doc) -> Doc
printEq0 Doc
equals) [(Doc, Doc)]
es
                in case LetBrand
br of
                Let -> [Doc] -> Doc
fsep [[Doc] -> Doc
sep [String -> Doc
text String
letS Doc -> Doc -> Doc
<+> Doc
des, String -> Doc
text String
inS], Doc
t]
                Where -> [Doc] -> Doc
fsep [[Doc] -> Doc
sep [Doc
t, String -> Doc
text String
whereS], Doc
des]
                Program -> String -> Doc
text String
programS Doc -> Doc -> Doc
<+> Doc
des
     , foldTermToken :: Term -> Token -> Doc
foldTermToken = (Token -> Doc) -> Term -> Token -> Doc
forall a b. a -> b -> a
const Token -> Doc
forall a. Pretty a => a -> Doc
pretty
     , foldMixTypeTerm :: Term -> TypeQual -> Type -> Range -> Doc
foldMixTypeTerm = \ _ q :: TypeQual
q t :: Type
t _ -> TypeQual -> Doc
forall a. Pretty a => a -> Doc
pretty TypeQual
q Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t
     , foldMixfixTerm :: Term -> [Doc] -> Doc
foldMixfixTerm = ([Doc] -> Doc) -> Term -> [Doc] -> Doc
forall a b. a -> b -> a
const [Doc] -> Doc
fsep
     , foldBracketTerm :: Term -> BracketKind -> [Doc] -> Range -> Doc
foldBracketTerm = \ _ k :: BracketKind
k l :: [Doc]
l _ -> BracketKind -> Doc -> Doc
bracket BracketKind
k (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas [Doc]
l
     , foldAsPattern :: Term -> VarDecl -> Doc -> Range -> Doc
foldAsPattern = \ _ (VarDecl v :: Id
v _ _ _) p :: Doc
p _ ->
           [Doc] -> Doc
fsep [Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
v, String -> Doc
text String
asP, Doc
p]
     , foldProgEq :: ProgEq -> Doc -> Doc -> Range -> (Doc, Doc)
foldProgEq = \ _ p :: Doc
p t :: Doc
t _ -> (Doc
p, Doc
t) }

printTerm :: Term -> Doc
printTerm :: Term -> Doc
printTerm = FoldRec Doc (Doc, Doc) -> Term -> Doc
forall a b. FoldRec a b -> Term -> a
foldTerm FoldRec Doc (Doc, Doc)
printTermRec

rmTypeRec :: MapRec
rmTypeRec :: MapRec
rmTypeRec = MapRec
mapRec
    { foldQualOp :: Term
-> OpBrand
-> PolyId
-> TypeScheme
-> [Type]
-> InstKind
-> Range
-> Term
foldQualOp = \ t :: Term
t _ (PolyId i :: Id
i _ _) _ tys :: [Type]
tys k :: InstKind
k ps :: Range
ps ->
        if Id -> [Id] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Id
i ([Id] -> Bool) -> [Id] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Id, TypeScheme) -> Id) -> [(Id, TypeScheme)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, TypeScheme) -> Id
forall a b. (a, b) -> a
fst [(Id, TypeScheme)]
bList then Id -> [Type] -> [Term] -> Range -> Term
ResolvedMixTerm Id
i
           (if InstKind
k InstKind -> InstKind -> Bool
forall a. Eq a => a -> a -> Bool
== InstKind
Infer then [] else [Type]
tys) [] Range
ps else Term
t
    , foldTypedTerm :: Term -> Term -> TypeQual -> Type -> Range -> Term
foldTypedTerm = \ _ nt :: Term
nt q :: TypeQual
q ty :: Type
ty ps :: Range
ps -> case TypeQual
q of
        Inferred -> Term
nt
        _ -> case Term
nt of
          TypedTerm tt :: Term
tt oq :: TypeQual
oq oty :: Type
oty _ | Type
oty Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ty Bool -> Bool -> Bool
|| TypeQual
oq TypeQual -> TypeQual -> Bool
forall a. Eq a => a -> a -> Bool
== TypeQual
InType ->
            if TypeQual
q TypeQual -> TypeQual -> Bool
forall a. Eq a => a -> a -> Bool
== TypeQual
AsType then Term -> TypeQual -> Type -> Range -> Term
TypedTerm Term
tt TypeQual
q Type
ty Range
ps else Term
nt
          QualVar (VarDecl _ oty :: Type
oty _ _) | Type
oty Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ty -> Term
nt
          _ -> Term -> TypeQual -> Type -> Range -> Term
TypedTerm Term
nt TypeQual
q Type
ty Range
ps }

rmSomeTypes :: Term -> Term
rmSomeTypes :: Term -> Term
rmSomeTypes = MapRec -> Term -> Term
forall a b. FoldRec a b -> Term -> a
foldTerm MapRec
rmTypeRec

-- | put parenthesis around applications
parenTermRec :: MapRec
parenTermRec :: MapRec
parenTermRec = let
     addParAppl :: Term -> Term
addParAppl t :: Term
t = case Term
t of
           ResolvedMixTerm _ _ [] _ -> Term
t
           QualVar _ -> Term
t
           QualOp {} -> Term
t
           TermToken _ -> Term
t
           BracketTerm {} -> Term
t
           TupleTerm _ _ -> Term
t
           _ -> [Term] -> Range -> Term
TupleTerm [Term
t] Range
nullRange
     in MapRec
mapRec
    { foldApplTerm :: Term -> Term -> Term -> Range -> Term
foldApplTerm = \ _ t1 :: Term
t1 t2 :: Term
t2 ->
         Term -> Term -> Range -> Term
ApplTerm (Term -> Term
addParAppl Term
t1) (Term -> Term
addParAppl Term
t2)
    , foldResolvedMixTerm :: Term -> Id -> [Type] -> [Term] -> Range -> Term
foldResolvedMixTerm = \ _ n :: Id
n tys :: [Type]
tys ->
        Id -> [Type] -> [Term] -> Range -> Term
ResolvedMixTerm Id
n [Type]
tys ([Term] -> Range -> Term)
-> ([Term] -> [Term]) -> [Term] -> Range -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Term) -> [Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Term
addParAppl
    , foldTypedTerm :: Term -> Term -> TypeQual -> Type -> Range -> Term
foldTypedTerm = \ _ ->
        Term -> TypeQual -> Type -> Range -> Term
TypedTerm (Term -> TypeQual -> Type -> Range -> Term)
-> (Term -> Term) -> Term -> TypeQual -> Type -> Range -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Term
addParAppl
    , foldMixfixTerm :: Term -> [Term] -> Term
foldMixfixTerm = \ _ -> [Term] -> Term
MixfixTerm ([Term] -> Term) -> ([Term] -> [Term]) -> [Term] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Term) -> [Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Term
addParAppl
    , foldAsPattern :: Term -> VarDecl -> Term -> Range -> Term
foldAsPattern = \ _ v :: VarDecl
v -> VarDecl -> Term -> Range -> Term
AsPattern VarDecl
v (Term -> Range -> Term) -> (Term -> Term) -> Term -> Range -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Term
addParAppl
    }

parenTerm :: Term -> Term
parenTerm :: Term -> Term
parenTerm = MapRec -> Term -> Term
forall a b. FoldRec a b -> Term -> a
foldTerm MapRec
parenTermRec

-- | print an equation with different symbols between pattern and term
printEq0 :: Doc -> (Doc, Doc) -> Doc
printEq0 :: Doc -> (Doc, Doc) -> Doc
printEq0 s :: Doc
s (p :: Doc
p, t :: Doc
t) = [Doc] -> Doc
sep [Doc
p, [Doc] -> Doc
hsep [Doc
s, Doc
t]]

printGenVarDecls :: [GenVarDecl] -> Doc
printGenVarDecls :: [GenVarDecl] -> Doc
printGenVarDecls = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([GenVarDecl] -> [Doc]) -> [GenVarDecl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc])
-> ([GenVarDecl] -> [Doc]) -> [GenVarDecl] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GenVarDecl] -> Doc) -> [[GenVarDecl]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  ( \ l :: [GenVarDecl]
l -> case [GenVarDecl]
l of
     [x :: GenVarDecl
x] -> GenVarDecl -> Doc
forall a. Pretty a => a -> Doc
pretty GenVarDecl
x
     GenVarDecl (VarDecl _ t :: Type
t _ _) : _ -> [Doc] -> Doc
sep
       [ [Id] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas
         ([Id] -> Doc) -> [Id] -> Doc
forall a b. (a -> b) -> a -> b
$ (GenVarDecl -> Id) -> [GenVarDecl] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (\ g :: GenVarDecl
g -> let GenVarDecl (VarDecl v :: Id
v _ _ _) = GenVarDecl
g in Id
v) [GenVarDecl]
l
       , Type -> Doc
printVarDeclType Type
t]
     GenTypeVarDecl (TypeArg _ e :: Variance
e c :: VarKind
c _ _ _ _) : _ -> [Doc] -> Doc
sep
       [ [Id] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas
         ([Id] -> Doc) -> [Id] -> Doc
forall a b. (a -> b) -> a -> b
$ (GenVarDecl -> Id) -> [GenVarDecl] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (\ g :: GenVarDecl
g -> let GenTypeVarDecl v :: TypeArg
v = GenVarDecl
g in TypeArg -> Id
varOfTypeArg TypeArg
v) [GenVarDecl]
l
       , Variance -> VarKind -> Doc
printVarKind Variance
e VarKind
c]
     _ -> String -> Doc
forall a. HasCallStack => String -> a
error "printGenVarDecls") ([[GenVarDecl]] -> [Doc])
-> ([GenVarDecl] -> [[GenVarDecl]]) -> [GenVarDecl] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenVarDecl -> GenVarDecl -> Bool)
-> [GenVarDecl] -> [[GenVarDecl]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy GenVarDecl -> GenVarDecl -> Bool
sameType

sameType :: GenVarDecl -> GenVarDecl -> Bool
sameType :: GenVarDecl -> GenVarDecl -> Bool
sameType g1 :: GenVarDecl
g1 g2 :: GenVarDecl
g2 = case (GenVarDecl
g1, GenVarDecl
g2) of
    (GenVarDecl (VarDecl _ t1 :: Type
t1 Comma _), GenVarDecl (VarDecl _ t2 :: Type
t2 _ _))
      | Type
t1 Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t2 -> Bool
True
    (GenTypeVarDecl (TypeArg _ e1 :: Variance
e1 c1 :: VarKind
c1 _ _ Comma _),
     GenTypeVarDecl (TypeArg _ e2 :: Variance
e2 c2 :: VarKind
c2 _ _ _ _)) | Variance
e1 Variance -> Variance -> Bool
forall a. Eq a => a -> a -> Bool
== Variance
e2 Bool -> Bool -> Bool
&& VarKind
c1 VarKind -> VarKind -> Bool
forall a. Eq a => a -> a -> Bool
== VarKind
c2 -> Bool
True
    _ -> Bool
False

printVarDeclType :: Type -> Doc
printVarDeclType :: Type -> Doc
printVarDeclType t :: Type
t = case Type
t of
       MixfixType [] -> Doc
empty
       _ -> Doc
colon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t

instance Pretty VarDecl where
    pretty :: VarDecl -> Doc
pretty (VarDecl v :: Id
v t :: Type
t _ _) = Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
v Doc -> Doc -> Doc
<+> Type -> Doc
printVarDeclType Type
t

instance Pretty GenVarDecl where
    pretty :: GenVarDecl -> Doc
pretty gvd :: GenVarDecl
gvd = case GenVarDecl
gvd of
        GenVarDecl v :: VarDecl
v -> VarDecl -> Doc
forall a. Pretty a => a -> Doc
pretty VarDecl
v
        GenTypeVarDecl tv :: TypeArg
tv -> TypeArg -> Doc
forall a. Pretty a => a -> Doc
pretty TypeArg
tv

instance Pretty TypeArg where
    pretty :: TypeArg -> Doc
pretty (TypeArg v :: Id
v e :: Variance
e c :: VarKind
c _ _ _ _) =
        Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
v Doc -> Doc -> Doc
<+> Variance -> VarKind -> Doc
printVarKind Variance
e VarKind
c

-- | don't print an empty list and put parens around longer lists
printList0 :: (Pretty a) => [a] -> Doc
printList0 :: [a] -> Doc
printList0 l :: [a]
l = case [a]
l of
    [] -> Doc
empty
    [x :: a
x] -> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x
    _ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [a] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [a]
l

instance Pretty BasicSpec where
    pretty :: BasicSpec -> Doc
pretty (BasicSpec l :: [Annoted BasicItem]
l) = if [Annoted BasicItem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Annoted BasicItem]
l then Doc -> Doc
specBraces Doc
empty else
        (GlobalAnnos -> GlobalAnnos) -> Doc -> Doc
changeGlobalAnnos GlobalAnnos -> GlobalAnnos
addBuiltins (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Annoted BasicItem -> Doc) -> [Annoted BasicItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Annoted BasicItem -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted BasicItem]
l

instance Pretty ProgEq where
    pretty :: ProgEq -> Doc
pretty (ProgEq p :: Term
p t :: Term
t ps :: Range
ps) = Doc -> (Doc, Doc) -> Doc
printEq0 Doc
equals ((Doc, Doc) -> Doc) -> (Doc, Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ FoldRec Doc (Doc, Doc) -> ProgEq -> (Doc, Doc)
forall a b. FoldRec a b -> ProgEq -> b
foldEq FoldRec Doc (Doc, Doc)
printTermRec
        (ProgEq -> (Doc, Doc)) -> ProgEq -> (Doc, Doc)
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Range -> ProgEq
ProgEq (Term -> Term
rmSomeTypes Term
p) (Term -> Term
rmSomeTypes Term
t) Range
ps

instance Pretty BasicItem where
    pretty :: BasicItem -> Doc
pretty bi :: BasicItem
bi = case BasicItem
bi of
        SigItems s :: SigItems
s -> SigItems -> Doc
forall a. Pretty a => a -> Doc
pretty SigItems
s
        ProgItems l :: [Annoted ProgEq]
l _ -> [Annoted ProgEq] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
noNullPrint [Annoted ProgEq]
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep [String -> Doc
keyword String
programS, [Annoted ProgEq] -> Doc
forall a. Pretty a => [Annoted a] -> Doc
semiAnnoted [Annoted ProgEq]
l]
        ClassItems i :: Instance
i l :: [Annoted ClassItem]
l _ -> [Annoted ClassItem] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
noNullPrint [Annoted ClassItem]
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ let
            b :: Doc
b = (ClassItem -> Doc) -> [Annoted ClassItem] -> Doc
forall a. (a -> Doc) -> [Annoted a] -> Doc
semiAnnos ClassItem -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted ClassItem]
l
            p :: Bool
p = [Annoted ClassItem] -> Bool
plClass [Annoted ClassItem]
l
            in case Instance
i of
            Plain -> String -> Doc
topSigKey (String
classS String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
p then "es" else "") Doc -> Doc -> Doc
<+> Doc
b
            Instance -> [Doc] -> Doc
sep [String -> Doc
keyword String
classS Doc -> Doc -> Doc
<+>
                             String -> Doc
keyword (String
instanceS String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
p then String
sS else ""), Doc
b]
        GenVarItems l :: [GenVarDecl]
l _ -> String -> Doc
topSigKey (String
varS String -> String -> String
forall a. [a] -> [a] -> [a]
++ [GenVarDecl] -> String
forall a. [a] -> String
pluralS [GenVarDecl]
l) Doc -> Doc -> Doc
<+> [GenVarDecl] -> Doc
printGenVarDecls [GenVarDecl]
l
        FreeDatatype l :: [Annoted DatatypeDecl]
l _ -> [Doc] -> Doc
sep
            [ String -> Doc
keyword String
freeS Doc -> Doc -> Doc
<+> String -> Doc
keyword (String
typeS String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Annoted DatatypeDecl] -> String
forall a. [a] -> String
pluralS [Annoted DatatypeDecl]
l)
            , (DatatypeDecl -> Doc) -> [Annoted DatatypeDecl] -> Doc
forall a. (a -> Doc) -> [Annoted a] -> Doc
semiAnnos DatatypeDecl -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted DatatypeDecl]
l]
        GenItems l :: [Annoted SigItems]
l _ -> let gkw :: Doc
gkw = String -> Doc
keyword String
generatedS in
            (if (Annoted SigItems -> Bool) -> [Annoted SigItems] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SigItems -> Bool
isDatatype (SigItems -> Bool)
-> (Annoted SigItems -> SigItems) -> Annoted SigItems -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annoted SigItems -> SigItems
forall a. Annoted a -> a
item) [Annoted SigItems]
l then \ i :: Doc
i -> Doc
gkw Doc -> Doc -> Doc
<+> Doc -> Doc
rmTopKey Doc
i
             else \ i :: Doc
i -> [Doc] -> Doc
sep [Doc
gkw, Doc -> Doc
specBraces Doc
i])
             (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Annoted SigItems -> Doc) -> [Annoted SigItems] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((SigItems -> Doc) -> Annoted SigItems -> Doc
forall a. (a -> Doc) -> Annoted a -> Doc
printAnnoted SigItems -> Doc
forall a. Pretty a => a -> Doc
pretty) [Annoted SigItems]
l
        AxiomItems vs :: [GenVarDecl]
vs fs :: [Annoted Term]
fs _ -> [Doc] -> Doc
sep
            [ if [GenVarDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenVarDecl]
vs then Doc
empty else Doc
forallDoc Doc -> Doc -> Doc
<+> [GenVarDecl] -> Doc
printGenVarDecls [GenVarDecl]
vs
           , case [Annoted Term]
fs of
             [] -> Doc
empty
             _ -> let pp :: Term -> Doc
pp = Doc -> Doc
addBullet (Doc -> Doc) -> (Term -> Doc) -> Term -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Doc
forall a. Pretty a => a -> Doc
pretty in
               [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Annoted Term -> Doc) -> [Annoted Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Term -> Doc) -> Annoted Term -> Doc
forall a. (a -> Doc) -> Annoted a -> Doc
printAnnoted Term -> Doc
pp) ([Annoted Term] -> [Annoted Term]
forall a. [a] -> [a]
init [Annoted Term]
fs)
                    [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [(Term -> Doc) -> Bool -> Annoted Term -> Doc
forall a. (a -> Doc) -> Bool -> Annoted a -> Doc
printSemiAnno Term -> Doc
pp Bool
True (Annoted Term -> Doc) -> Annoted Term -> Doc
forall a b. (a -> b) -> a -> b
$ [Annoted Term] -> Annoted Term
forall a. [a] -> a
last [Annoted Term]
fs]]
        Internal l :: [Annoted BasicItem]
l _ -> [Doc] -> Doc
sep
            [ String -> Doc
keyword String
internalS
            , Doc -> Doc
specBraces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Annoted BasicItem -> Doc) -> [Annoted BasicItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((BasicItem -> Doc) -> Annoted BasicItem -> Doc
forall a. (a -> Doc) -> Annoted a -> Doc
printAnnoted BasicItem -> Doc
forall a. Pretty a => a -> Doc
pretty) [Annoted BasicItem]
l]

plClass :: [Annoted ClassItem] -> Bool
plClass :: [Annoted ClassItem] -> Bool
plClass l :: [Annoted ClassItem]
l = case (Annoted ClassItem -> ClassItem)
-> [Annoted ClassItem] -> [ClassItem]
forall a b. (a -> b) -> [a] -> [b]
map Annoted ClassItem -> ClassItem
forall a. Annoted a -> a
item [Annoted ClassItem]
l of
    _ : _ : _ -> Bool
True
    [ClassItem (ClassDecl (_ : _ : _) _ _) _ _] -> Bool
True
    _ -> Bool
False

pluralS :: [a] -> String
pluralS :: [a] -> String
pluralS l :: [a]
l = case [a]
l of
    _ : _ : _ -> String
sS
    _ -> ""

isDatatype :: SigItems -> Bool
isDatatype :: SigItems -> Bool
isDatatype si :: SigItems
si = case SigItems
si of
    TypeItems _ l :: [Annoted TypeItem]
l _ -> (Annoted TypeItem -> Bool) -> [Annoted TypeItem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
      ((\ t :: TypeItem
t -> case TypeItem
t of
        Datatype _ -> Bool
True
        _ -> Bool
False) (TypeItem -> Bool)
-> (Annoted TypeItem -> TypeItem) -> Annoted TypeItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annoted TypeItem -> TypeItem
forall a. Annoted a -> a
item) [Annoted TypeItem]
l
    _ -> Bool
False

instance Pretty OpBrand where
    pretty :: OpBrand -> Doc
pretty = String -> Doc
keyword (String -> Doc) -> (OpBrand -> String) -> OpBrand -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpBrand -> String
forall a. Show a => a -> String
show

instance Pretty SigItems where
    pretty :: SigItems -> Doc
pretty si :: SigItems
si = case SigItems
si of
        TypeItems i :: Instance
i l :: [Annoted TypeItem]
l _ -> [Annoted TypeItem] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
noNullPrint [Annoted TypeItem]
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
          let b :: Doc
b = (TypeItem -> Doc) -> [Annoted TypeItem] -> Doc
forall a. (a -> Doc) -> [Annoted a] -> Doc
semiAnnos TypeItem -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted TypeItem]
l in case Instance
i of
            Plain -> String -> Doc
topSigKey (String
typeS String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Annoted TypeItem] -> String
plTypes [Annoted TypeItem]
l) Doc -> Doc -> Doc
<+> Doc
b
            Instance ->
              [Doc] -> Doc
sep [String -> Doc
keyword String
typeS Doc -> Doc -> Doc
<+> String -> Doc
keyword (String
instanceS String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Annoted TypeItem] -> String
plTypes [Annoted TypeItem]
l), Doc
b]
        OpItems b :: OpBrand
b l :: [Annoted OpItem]
l _ -> [Annoted OpItem] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
noNullPrint [Annoted OpItem]
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
topSigKey (OpBrand -> String
forall a. Show a => a -> String
show OpBrand
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Annoted OpItem] -> String
plOps [Annoted OpItem]
l)
            Doc -> Doc -> Doc
<+> let po :: OpItem -> Doc
po = Bool -> OpItem -> Doc
prettyOpItem (Bool -> OpItem -> Doc) -> Bool -> OpItem -> Doc
forall a b. (a -> b) -> a -> b
$ OpBrand -> Bool
isPred OpBrand
b in
                if case Annoted OpItem -> OpItem
forall a. Annoted a -> a
item (Annoted OpItem -> OpItem) -> Annoted OpItem -> OpItem
forall a b. (a -> b) -> a -> b
$ [Annoted OpItem] -> Annoted OpItem
forall a. [a] -> a
last [Annoted OpItem]
l of
                  OpDecl _ _ a :: [OpAttr]
a@(_ : _) _ -> case [OpAttr] -> OpAttr
forall a. [a] -> a
last [OpAttr]
a of
                    UnitOpAttr {} -> Bool
True
                    _ -> Bool
False
                  OpDefn {} -> Bool
True
                  _ -> Bool
False
                then [Doc] -> Doc
vcat ((Annoted OpItem -> Doc) -> [Annoted OpItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((OpItem -> Doc) -> Bool -> Annoted OpItem -> Doc
forall a. (a -> Doc) -> Bool -> Annoted a -> Doc
printSemiAnno OpItem -> Doc
po Bool
True) [Annoted OpItem]
l)
                else (OpItem -> Doc) -> [Annoted OpItem] -> Doc
forall a. (a -> Doc) -> [Annoted a] -> Doc
semiAnnos OpItem -> Doc
po [Annoted OpItem]
l

plTypes :: [Annoted TypeItem] -> String
plTypes :: [Annoted TypeItem] -> String
plTypes l :: [Annoted TypeItem]
l = case (Annoted TypeItem -> TypeItem) -> [Annoted TypeItem] -> [TypeItem]
forall a b. (a -> b) -> [a] -> [b]
map Annoted TypeItem -> TypeItem
forall a. Annoted a -> a
item [Annoted TypeItem]
l of
    _ : _ : _ -> String
sS
    [TypeDecl (_ : _ : _) _ _] -> String
sS
    [SubtypeDecl (_ : _ : _) _ _] -> String
sS
    [IsoDecl (_ : _ : _) _] -> String
sS
    _ -> ""

plOps :: [Annoted OpItem] -> String
plOps :: [Annoted OpItem] -> String
plOps l :: [Annoted OpItem]
l = case (Annoted OpItem -> OpItem) -> [Annoted OpItem] -> [OpItem]
forall a b. (a -> b) -> [a] -> [b]
map Annoted OpItem -> OpItem
forall a. Annoted a -> a
item [Annoted OpItem]
l of
    _ : _ : _ -> String
sS
    [OpDecl (_ : _ : _) _ _ _] -> String
sS
    _ -> ""

isSimpleTypeItem :: TypeItem -> Bool
isSimpleTypeItem :: TypeItem -> Bool
isSimpleTypeItem ti :: TypeItem
ti = case TypeItem
ti of
    TypeDecl l :: [TypePattern]
l k :: Kind
k _ -> Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
universe Bool -> Bool -> Bool
&& (TypePattern -> Bool) -> [TypePattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TypePattern -> Bool
isSimpleTypePat [TypePattern]
l
    SubtypeDecl l :: [TypePattern]
l (TypeName i :: Id
i _ _) _ ->
        Bool -> Bool
not (Id -> Bool
isMixfix Id
i) Bool -> Bool -> Bool
&& (TypePattern -> Bool) -> [TypePattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TypePattern -> Bool
isSimpleTypePat [TypePattern]
l
    SubtypeDefn p :: TypePattern
p (Var _) t :: Type
t _ _ ->
        TypePattern -> Bool
isSimpleTypePat TypePattern
p Bool -> Bool -> Bool
&& Type -> Bool
isSimpleType Type
t
    _ -> Bool
False

isSimpleTypePat :: TypePattern -> Bool
isSimpleTypePat :: TypePattern -> Bool
isSimpleTypePat tp :: TypePattern
tp = case TypePattern
tp of
    TypePattern i :: Id
i [] _ -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Id -> Bool
isMixfix Id
i
    _ -> Bool
False

isSimpleType :: Type -> Bool
isSimpleType :: Type -> Bool
isSimpleType t :: Type
t = case Type
t of
    TypeName i :: Id
i _ _ -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Id -> Bool
isMixfix Id
i
    TypeToken _ -> Bool
True
    MixfixType [TypeToken _, BracketType Squares (_ : _) _] -> Bool
True
    _ -> Bool
False

instance Pretty ClassItem where
    pretty :: ClassItem -> Doc
pretty (ClassItem d :: ClassDecl
d l :: [Annoted BasicItem]
l _) = ClassDecl -> Doc
forall a. Pretty a => a -> Doc
pretty ClassDecl
d Doc -> Doc -> Doc
$+$ [Annoted BasicItem] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
noNullPrint [Annoted BasicItem]
l
                   (Doc -> Doc
specBraces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Annoted BasicItem -> Doc) -> [Annoted BasicItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((BasicItem -> Doc) -> Annoted BasicItem -> Doc
forall a. (a -> Doc) -> Annoted a -> Doc
printAnnoted BasicItem -> Doc
forall a. Pretty a => a -> Doc
pretty) [Annoted BasicItem]
l)

instance Pretty ClassDecl where
    pretty :: ClassDecl -> Doc
pretty (ClassDecl l :: [Id]
l k :: Kind
k _) = let cs :: Doc
cs = [Id] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Id]
l in
        if Kind
k Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
universe then Doc
cs else [Doc] -> Doc
fsep [Doc
cs, Doc
less, Kind -> Doc
forall a. Pretty a => a -> Doc
pretty Kind
k]

instance Pretty Vars where
    pretty :: Vars -> Doc
pretty vd :: Vars
vd = case Vars
vd of
        Var v :: Id
v -> Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
v
        VarTuple vs :: [Vars]
vs _ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Vars] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Vars]
vs

instance Pretty TypeItem where
    pretty :: TypeItem -> Doc
pretty ti :: TypeItem
ti = case TypeItem
ti of
        TypeDecl l :: [TypePattern]
l k :: Kind
k _ -> [Doc] -> Doc
sep [[TypePattern] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [TypePattern]
l, Kind -> Doc
printKind Kind
k]
        SubtypeDecl l :: [TypePattern]
l t :: Type
t _ ->
            [Doc] -> Doc
fsep [[TypePattern] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [TypePattern]
l, Doc
less, Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t]
        IsoDecl l :: [TypePattern]
l _ -> [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
equals) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (TypePattern -> Doc) -> [TypePattern] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypePattern -> Doc
forall a. Pretty a => a -> Doc
pretty [TypePattern]
l
        SubtypeDefn p :: TypePattern
p v :: Vars
v t :: Type
t f :: Annoted Term
f _ ->
            [Doc] -> Doc
fsep [TypePattern -> Doc
forall a. Pretty a => a -> Doc
pretty TypePattern
p, Doc
equals,
                  Doc -> Doc
specBraces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep
                  [Vars -> Doc
forall a. Pretty a => a -> Doc
pretty Vars
v, Doc
colon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t, Doc
bullet Doc -> Doc -> Doc
<+> Annoted Term -> Doc
forall a. Pretty a => a -> Doc
pretty Annoted Term
f]]
        AliasType p :: TypePattern
p _ (TypeScheme l :: [TypeArg]
l t :: Type
t _) _ ->
            [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ TypePattern -> Doc
forall a. Pretty a => a -> Doc
pretty TypePattern
p Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (TypeArg -> Doc) -> [TypeArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Id -> Doc
forall a. Pretty a => a -> Doc
pretty (Id -> Doc) -> (TypeArg -> Id) -> TypeArg -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeArg -> Id
varOfTypeArg) [TypeArg]
l
                  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
assignS Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t]
        Datatype t :: DatatypeDecl
t -> DatatypeDecl -> Doc
forall a. Pretty a => a -> Doc
pretty DatatypeDecl
t

printItScheme :: [PolyId] -> Bool -> TypeScheme -> Doc
printItScheme :: [PolyId] -> Bool -> TypeScheme -> Doc
printItScheme ps :: [PolyId]
ps b :: Bool
b = (case [PolyId]
ps of
    [p :: PolyId
p] -> PolyId -> TypeScheme -> Doc
printTypeScheme PolyId
p
    _ -> TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pretty) (TypeScheme -> Doc)
-> (TypeScheme -> TypeScheme) -> TypeScheme -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
b then TypeScheme -> TypeScheme
unPredTypeScheme else TypeScheme -> TypeScheme
forall a. a -> a
id)

printHead :: [[VarDecl]] -> [Doc]
printHead :: [[VarDecl]] -> [Doc]
printHead = ([VarDecl] -> Doc) -> [[VarDecl]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) (Doc -> Doc) -> ([VarDecl] -> Doc) -> [VarDecl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
parens (Doc -> Doc) -> ([VarDecl] -> Doc) -> [VarDecl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenVarDecl] -> Doc
printGenVarDecls ([GenVarDecl] -> Doc)
-> ([VarDecl] -> [GenVarDecl]) -> [VarDecl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarDecl -> GenVarDecl) -> [VarDecl] -> [GenVarDecl]
forall a b. (a -> b) -> [a] -> [b]
map VarDecl -> GenVarDecl
GenVarDecl)

prettyOpItem :: Bool -> OpItem -> Doc
prettyOpItem :: Bool -> OpItem -> Doc
prettyOpItem b :: Bool
b oi :: OpItem
oi = case OpItem
oi of
        OpDecl l :: [PolyId]
l t :: TypeScheme
t a :: [OpAttr]
a _ -> [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((PolyId -> Doc) -> [PolyId] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PolyId -> Doc
forall a. Pretty a => a -> Doc
pretty [PolyId]
l)
          [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
colon Doc -> Doc -> Doc
<+>
              (if [OpAttr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpAttr]
a then Doc -> Doc
forall a. a -> a
id else (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma)) ([PolyId] -> Bool -> TypeScheme -> Doc
printItScheme [PolyId]
l Bool
b TypeScheme
t)]
          [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((OpAttr -> Doc) -> [OpAttr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map OpAttr -> Doc
forall a. Pretty a => a -> Doc
pretty [OpAttr]
a)
        OpDefn n :: PolyId
n ps :: [[VarDecl]]
ps s :: TypeScheme
s t :: Term
t _ -> [Doc] -> Doc
fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            (if [[VarDecl]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[VarDecl]]
ps then (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) else Doc -> Doc
forall a. a -> a
id) (PolyId -> Doc
forall a. Pretty a => a -> Doc
pretty PolyId
n)
            Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [[VarDecl]] -> [Doc]
printHead [[VarDecl]]
ps
            [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (if Bool
b then [] else [Doc
colon Doc -> Doc -> Doc
<+> [PolyId] -> Bool -> TypeScheme -> Doc
printItScheme [PolyId
n] Bool
b TypeScheme
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space])
            [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [(if Bool
b then Doc
equiv else Doc
equals) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space, Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
t]

instance Pretty PolyId where
    pretty :: PolyId -> Doc
pretty (PolyId i :: Id
i@(Id ts :: [Token]
ts cs :: [Id]
cs ps :: Range
ps) tys :: [TypeArg]
tys _) = if [TypeArg] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeArg]
tys then Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
i else
      let (fts :: [Token]
fts, plcs :: [Token]
plcs) = [Token] -> ([Token], [Token])
splitMixToken [Token]
ts
      in Id -> Doc
idDoc ([Token] -> [Id] -> Range -> Id
Id [Token]
fts [Id]
cs Range
ps) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets ([TypeArg] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [TypeArg]
tys)
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat ((Token -> Doc) -> [Token] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc
forall a. Pretty a => a -> Doc
pretty [Token]
plcs)

instance Pretty BinOpAttr where
    pretty :: BinOpAttr -> Doc
pretty a :: BinOpAttr
a = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case BinOpAttr
a of
        Assoc -> String
assocS
        Comm -> String
commS
        Idem -> String
idemS

instance Pretty OpAttr where
    pretty :: OpAttr -> Doc
pretty oa :: OpAttr
oa = case OpAttr
oa of
        BinOpAttr a :: BinOpAttr
a _ -> BinOpAttr -> Doc
forall a. Pretty a => a -> Doc
pretty BinOpAttr
a
        UnitOpAttr t :: Term
t _ -> String -> Doc
text String
unitS Doc -> Doc -> Doc
<+> Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
t

instance Pretty DatatypeDecl where
    pretty :: DatatypeDecl -> Doc
pretty (DatatypeDecl p :: TypePattern
p k :: Kind
k alts :: [Annoted Alternative]
alts d :: [Id]
d _) =
        [Doc] -> Doc
fsep [ TypePattern -> Doc
forall a. Pretty a => a -> Doc
pretty TypePattern
p, Kind -> Doc
printKind Kind
k, Doc
defn
              Doc -> Doc -> Doc
<+> [Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate (Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
bar Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space)
                      ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Annoted Alternative -> Doc) -> [Annoted Alternative] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Annoted Alternative -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted Alternative]
alts)
             , case [Id]
d of
                 [] -> Doc
empty
                 _ -> String -> Doc
keyword String
derivingS Doc -> Doc -> Doc
<+> [Id] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Id]
d]

instance Pretty Alternative where
    pretty :: Alternative -> Doc
pretty alt :: Alternative
alt = case Alternative
alt of
        Constructor n :: Id
n cs :: [[Component]]
cs p :: Partiality
p _ -> Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
n Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep
          (([Component] -> Doc) -> [[Component]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ( \ l :: [Component]
l -> case ([Component]
l, Partiality
p) of
-- comment out the following line to output real CASL
            ([NoSelector (TypeToken t :: Token
t)], Total) | Id -> Bool
isSimpleId Id
n -> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
t
            _ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Component] -> Doc
forall a. Pretty a => [a] -> Doc
semiDs [Component]
l) [[Component]]
cs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Partiality -> Doc
forall a. Pretty a => a -> Doc
pretty Partiality
p
        Subtype l :: [Type]
l _ -> String -> Doc
text String
typeS Doc -> Doc -> Doc
<+> [Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Type]
l

instance Pretty Component where
    pretty :: Component -> Doc
pretty sel :: Component
sel = case Component
sel of
        Selector n :: Id
n _ t :: Type
t _ _ -> [Doc] -> Doc
sep [Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
n, Doc
colon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t]
        NoSelector t :: Type
t -> Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
t

instance Pretty Symb where
    pretty :: Symb -> Doc
pretty (Symb i :: Id
i mt :: Maybe SymbType
mt _) =
        [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
i Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: case Maybe SymbType
mt of
            Nothing -> []
            Just (SymbType t :: TypeScheme
t) -> [Doc
colon Doc -> Doc -> Doc
<+> TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pretty TypeScheme
t]

instance Pretty SymbItems where
    pretty :: SymbItems -> Doc
pretty (SymbItems k :: SymbKind
k syms :: [Symb]
syms _ _) =
        SymbKind -> [Symb] -> Doc
forall a. SymbKind -> [a] -> Doc
printSK SymbKind
k [Symb]
syms Doc -> Doc -> Doc
<+> [Symb] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [Symb]
syms

instance Pretty SymbOrMap where
    pretty :: SymbOrMap -> Doc
pretty (SymbOrMap s :: Symb
s mt :: Maybe Symb
mt _) =
        [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Symb -> Doc
forall a. Pretty a => a -> Doc
pretty Symb
s Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: case Maybe Symb
mt of
            Nothing -> []
            Just t :: Symb
t -> [Doc
mapsto Doc -> Doc -> Doc
<+> Symb -> Doc
forall a. Pretty a => a -> Doc
pretty Symb
t]

instance Pretty SymbMapItems where
    pretty :: SymbMapItems -> Doc
pretty (SymbMapItems k :: SymbKind
k syms :: [SymbOrMap]
syms _ _) =
        SymbKind -> [SymbOrMap] -> Doc
forall a. SymbKind -> [a] -> Doc
printSK SymbKind
k [SymbOrMap]
syms Doc -> Doc -> Doc
<+> [SymbOrMap] -> Doc
forall a. Pretty a => [a] -> Doc
ppWithCommas [SymbOrMap]
syms

-- | print symbol kind
printSK :: SymbKind -> [a] -> Doc
printSK :: SymbKind -> [a] -> Doc
printSK k :: SymbKind
k l :: [a]
l = case SymbKind
k of
      Implicit -> Doc
empty
      _ -> String -> Doc
keyword (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop 3 (SymbKind -> String
forall a. Show a => a -> String
show SymbKind
k) String -> String -> String
forall a. [a] -> [a] -> [a]
++ case [a]
l of
        _ : _ : _ -> String
sS
        _ -> ""