----------------------------------------------------------------------
-- |
-- Module      : GF.Grammar.Printer
-- Maintainer  : Krasimir Angelov
-- Stability   : (stable)
-- Portability : (portable)
--
-----------------------------------------------------------------------------

{-# LANGUAGE FlexibleContexts #-}
module GF.Grammar.Printer
           ( -- ** Pretty printing
             TermPrintQual(..)
           , ppModule
           , ppJudgement
           , ppParams
           , ppTerm
           , ppPatt
           , ppValue
           , ppConstrs
           , ppQIdent
           , ppMeta
           , getAbs
           ) where
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

import GF.Infra.Ident
import GF.Infra.Option
import GF.Grammar.Values
import GF.Grammar.Grammar

import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq)

import GF.Text.Pretty
import Data.Maybe (isNothing)
import Data.List  (intersperse)
import qualified Data.Map as Map
--import qualified Data.IntMap as IntMap
--import qualified Data.Set as Set
import qualified Data.Array.IArray as Array

data TermPrintQual
  = Terse | Unqualified | Qualified | Internal
  deriving TermPrintQual -> TermPrintQual -> Bool
(TermPrintQual -> TermPrintQual -> Bool)
-> (TermPrintQual -> TermPrintQual -> Bool) -> Eq TermPrintQual
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TermPrintQual -> TermPrintQual -> Bool
$c/= :: TermPrintQual -> TermPrintQual -> Bool
== :: TermPrintQual -> TermPrintQual -> Bool
$c== :: TermPrintQual -> TermPrintQual -> Bool
Eq

instance Pretty Grammar where
  pp :: Grammar -> Doc
pp = [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat ([Doc] -> Doc) -> (Grammar -> [Doc]) -> Grammar -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceModule -> Doc) -> [SourceModule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> SourceModule -> Doc
ppModule TermPrintQual
Qualified) ([SourceModule] -> [Doc])
-> (Grammar -> [SourceModule]) -> Grammar -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grammar -> [SourceModule]
modules

ppModule :: TermPrintQual -> SourceModule -> Doc
ppModule :: TermPrintQual -> SourceModule -> Doc
ppModule TermPrintQual
q (ModuleName
mn, ModInfo ModuleType
mtype ModuleStatus
mstat Options
opts [(ModuleName, MInclude)]
exts Maybe (ModuleName, MInclude, [(ModuleName, ModuleName)])
with [OpenSpec]
opens [ModuleName]
_ FilePath
_ Maybe (Array SeqId Sequence)
mseqs Map Ident Info
jments) =
    Doc
hdr Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
    SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 (Options -> Doc
ppOptions Options
opts Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
            [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (((Ident, Info) -> Doc) -> [(Ident, Info)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> (Ident, Info) -> Doc
forall a2. Pretty a2 => TermPrintQual -> (a2, Info) -> Doc
ppJudgement TermPrintQual
q) (Map Ident Info -> [(Ident, Info)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Ident Info
jments)) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
            Doc
-> (Array SeqId Sequence -> Doc)
-> Maybe (Array SeqId Sequence)
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (TermPrintQual -> Array SeqId Sequence -> Doc
forall (a :: * -> * -> *) i (a :: * -> * -> *).
(IArray a Symbol, Ix i, IArray a (a i Symbol)) =>
TermPrintQual -> a SeqId (a i Symbol) -> Doc
ppSequences TermPrintQual
q) Maybe (Array SeqId Sequence)
mseqs) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
    Char
ftr
    where
      hdr :: Doc
hdr = Doc
complModDoc Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc
modTypeDoc Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
            [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
"**") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                  (Doc -> Bool) -> [Doc] -> [Doc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc -> Bool) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)  ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [ ((ModuleName, MInclude) -> Doc) -> [(ModuleName, MInclude)] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct (ModuleName, MInclude) -> Doc
forall a1. Pretty a1 => (a1, MInclude) -> Doc
ppExtends [(ModuleName, MInclude)]
exts
                                            , Doc
-> ((ModuleName, MInclude, [(ModuleName, ModuleName)]) -> Doc)
-> Maybe (ModuleName, MInclude, [(ModuleName, ModuleName)])
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (ModuleName, MInclude, [(ModuleName, ModuleName)]) -> Doc
forall a1 a2 a1.
(Pretty a1, Pretty a2, Pretty a1) =>
(a1, MInclude, [(a1, a2)]) -> Doc
ppWith Maybe (ModuleName, MInclude, [(ModuleName, ModuleName)])
with
                                            , if [OpenSpec] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpenSpec]
opens
                                                then Char -> Doc
forall a. Pretty a => a -> Doc
pp Char
'{'
                                                else FilePath
"open" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> (OpenSpec -> Doc) -> [OpenSpec] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct OpenSpec -> Doc
ppOpenSpec [OpenSpec]
opens Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"in" Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{'
                                            ])

      ftr :: Char
ftr = Char
'}'

      complModDoc :: Doc
complModDoc =
        case ModuleStatus
mstat of
          ModuleStatus
MSComplete   -> Doc
empty
          ModuleStatus
MSIncomplete -> FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
"incomplete"

      modTypeDoc :: Doc
modTypeDoc =
        case ModuleType
mtype of
          ModuleType
MTAbstract         -> FilePath
"abstract"  FilePath -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
mn
          ModuleType
MTResource         -> FilePath
"resource"  FilePath -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
mn
          MTConcrete ModuleName
abs     -> FilePath
"concrete"  FilePath -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
mn Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"of" Doc -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
abs
          ModuleType
MTInterface        -> FilePath
"interface" FilePath -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
mn
          MTInstance (ModuleName, MInclude)
ie      -> FilePath
"instance"  FilePath -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
mn Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"of" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> (ModuleName, MInclude) -> Doc
forall a1. Pretty a1 => (a1, MInclude) -> Doc
ppExtends (ModuleName, MInclude)
ie

      ppExtends :: (a1, MInclude) -> Doc
ppExtends (a1
id,MInclude
MIAll        ) = a1 -> Doc
forall a. Pretty a => a -> Doc
pp a1
id
      ppExtends (a1
id,MIOnly   [Ident]
incs) = a1
id         a1 -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
brackets ((Ident -> Doc) -> [Ident] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct Ident -> Doc
forall a. Pretty a => a -> Doc
pp [Ident]
incs)
      ppExtends (a1
id,MIExcept [Ident]
incs) = a1
id a1 -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'-' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
brackets ((Ident -> Doc) -> [Ident] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct Ident -> Doc
forall a. Pretty a => a -> Doc
pp [Ident]
incs)

      ppWith :: (a1, MInclude, [(a1, a2)]) -> Doc
ppWith (a1
id,MInclude
ext,[(a1, a2)]
opens) = (a1, MInclude) -> Doc
forall a1. Pretty a1 => (a1, MInclude) -> Doc
ppExtends (a1
id,MInclude
ext) Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"with" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ((a1, a2) -> Doc) -> [(a1, a2)] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct (a1, a2) -> Doc
forall a2 a1. (Pretty a2, Pretty a1) => (a1, a2) -> Doc
ppInstSpec [(a1, a2)]
opens

ppOptions :: Options -> Doc
ppOptions Options
opts =
  FilePath
"flags" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat [FilePath
option FilePath -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Literal -> Doc
ppLit Literal
value Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';' | (FilePath
option,Literal
value) <- Options -> [(FilePath, Literal)]
optionsGFO Options
opts])

ppJudgement :: TermPrintQual -> (a2, Info) -> Doc
ppJudgement TermPrintQual
q (a2
id, AbsCat Maybe (L Context)
pcont ) =
  FilePath
"cat" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
  (case Maybe (L Context)
pcont of
     Just (L Location
_ Context
cont) -> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (((BindType, Ident, Term) -> Doc) -> Context -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> (BindType, Ident, Term) -> Doc
forall a. TermPrintQual -> (a, Ident, Term) -> Doc
ppDecl TermPrintQual
q) Context
cont)
     Maybe (L Context)
Nothing         -> Doc
empty) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
ppJudgement TermPrintQual
q (a2
id, AbsFun Maybe (L Term)
ptype Maybe SeqId
_ Maybe [L Equation]
pexp Maybe Bool
poper) =
  let kind :: FilePath
kind | Maybe [L Equation] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [L Equation]
pexp      = FilePath
"data"
           | Maybe Bool
poper Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False = FilePath
"oper"
           | Bool
otherwise           = FilePath
"fun"
  in
  (case Maybe (L Term)
ptype of
     Just (L Location
_ Term
typ) -> FilePath
kind FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
typ Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing        -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case Maybe [L Equation]
pexp of
     Just []  -> Doc
empty
     Just [L Equation]
eqs -> FilePath
"def" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat [a2
id a2 -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep ((Patt -> Doc) -> [Patt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Integer -> Patt -> Doc
forall a. (Num a, Ord a) => TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q Integer
2) [Patt]
ps) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
e Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';' | L Location
_ ([Patt]
ps,Term
e) <- [L Equation]
eqs]
     Maybe [L Equation]
Nothing  -> Doc
empty)
ppJudgement TermPrintQual
q (a2
id, ResParam Maybe (L [Param])
pparams Maybe [Term]
_) =
  FilePath
"param" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
  (case Maybe (L [Param])
pparams of
     Just (L Location
_ [Param]
ps) -> Char
'=' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> [Param] -> Doc
forall a1 a.
Pretty a1 =>
TermPrintQual -> [(a1, [(a, Ident, Term)])] -> Doc
ppParams TermPrintQual
q [Param]
ps
     Maybe (L [Param])
_             -> Doc
empty) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
ppJudgement TermPrintQual
q (a2
id, ResValue L Term
pvalue) =
  FilePath
"-- param constructor" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
  (case L Term
pvalue of
     (L Location
_ Term
ty) -> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
ty) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
ppJudgement TermPrintQual
q (a2
id, ResOper  Maybe (L Term)
ptype Maybe (L Term)
pexp) =
  FilePath
"oper" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
  (case Maybe (L Term)
ptype of {Just (L Location
_ Term
t) -> Char
':'  Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
t; Maybe (L Term)
Nothing -> Doc
empty} Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
   case Maybe (L Term)
pexp  of {Just (L Location
_ Term
e) -> Char
'=' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
e; Maybe (L Term)
Nothing -> Doc
empty}) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
ppJudgement TermPrintQual
q (a2
id, ResOverload [ModuleName]
ids [(L Term, L Term)]
defs) =
  FilePath
"oper" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
  (FilePath
"overload" FilePath -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
   SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat [a2
id a2 -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> (Char
':' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
ty Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ Char
'=' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
e Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';') | (L Location
_ Term
ty,L Location
_ Term
e) <- [(L Term, L Term)]
defs]) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
   Char
'}') Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
ppJudgement TermPrintQual
q (a2
id, CncCat Maybe (L Term)
pcat Maybe (L Term)
pdef Maybe (L Term)
pref Maybe (L Term)
pprn Maybe PMCFG
mpmcfg) =
  (case Maybe (L Term)
pcat of
     Just (L Location
_ Term
typ) -> FilePath
"lincat" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
typ Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing        -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case Maybe (L Term)
pdef of
     Just (L Location
_ Term
exp) -> FilePath
"lindef" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
exp Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing        -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case Maybe (L Term)
pref of
     Just (L Location
_ Term
exp) -> FilePath
"linref" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
exp Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing        -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case Maybe (L Term)
pprn of
     Just (L Location
_ Term
prn) -> FilePath
"printname" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
prn Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing        -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case (Maybe PMCFG
mpmcfg,TermPrintQual
q) of
     (Just (PMCFG [Production]
prods Array SeqId (UArray SeqId SeqId)
funs),TermPrintQual
Internal)
                    -> FilePath
"pmcfg" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                       SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat ((Production -> Doc) -> [Production] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Production -> Doc
ppProduction [Production]
prods) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                               Char
' ' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                               [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (((SeqId, UArray SeqId SeqId) -> Doc)
-> [(SeqId, UArray SeqId SeqId)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(SeqId
funid,UArray SeqId SeqId
arr) -> SeqId -> Doc
ppFunId SeqId
funid Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
":=" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
                                                          Doc -> Doc
forall a. Pretty a => a -> Doc
parens ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
',' ((SeqId -> Doc) -> [SeqId] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SeqId -> Doc
ppSeqId (UArray SeqId SeqId -> [SeqId]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems UArray SeqId SeqId
arr)))))
                                         (Array SeqId (UArray SeqId SeqId) -> [(SeqId, UArray SeqId SeqId)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs Array SeqId (UArray SeqId SeqId)
funs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                       Char
'}'
     (Maybe PMCFG, TermPrintQual)
_              -> Doc
empty)
ppJudgement TermPrintQual
q (a2
id, CncFun  Maybe (Ident, Context, Term)
ptype Maybe (L Term)
pdef Maybe (L Term)
pprn Maybe PMCFG
mpmcfg) =
  (case Maybe (L Term)
pdef of
     Just (L Location
_ Term
e) -> let ([(BindType, Ident)]
xs,Term
e') = Term -> ([(BindType, Ident)], Term)
getAbs Term
e
                     in FilePath
"lin" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (((BindType, Ident) -> Doc) -> [(BindType, Ident)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (BindType, Ident) -> Doc
forall a. Pretty a => (BindType, a) -> Doc
ppBind [(BindType, Ident)]
xs) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
e' Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing      -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case Maybe (L Term)
pprn of
     Just (L Location
_ Term
prn) -> FilePath
"printname" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
prn Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
     Maybe (L Term)
Nothing        -> Doc
empty) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
  (case (Maybe PMCFG
mpmcfg,TermPrintQual
q) of
     (Just (PMCFG [Production]
prods Array SeqId (UArray SeqId SeqId)
funs),TermPrintQual
Internal)
                    -> FilePath
"pmcfg" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                       SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat ((Production -> Doc) -> [Production] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Production -> Doc
ppProduction [Production]
prods) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                               Char
' ' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                               [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (((SeqId, UArray SeqId SeqId) -> Doc)
-> [(SeqId, UArray SeqId SeqId)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(SeqId
funid,UArray SeqId SeqId
arr) -> SeqId -> Doc
ppFunId SeqId
funid Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
":=" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
                                                          Doc -> Doc
forall a. Pretty a => a -> Doc
parens ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
',' ((SeqId -> Doc) -> [SeqId] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SeqId -> Doc
ppSeqId (UArray SeqId SeqId -> [SeqId]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems UArray SeqId SeqId
arr)))))
                                         (Array SeqId (UArray SeqId SeqId) -> [(SeqId, UArray SeqId SeqId)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs Array SeqId (UArray SeqId SeqId)
funs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                       Char
'}'
     (Maybe PMCFG, TermPrintQual)
_              -> Doc
empty)
ppJudgement TermPrintQual
q (a2
id, AnyInd Bool
cann ModuleName
mid) =
  case TermPrintQual
q of
    TermPrintQual
Internal -> FilePath
"ind" FilePath -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
id Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> (if Bool
cann then FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
"canonical" else Doc
empty) Doc -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
mid Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'
    TermPrintQual
_        -> Doc
empty

instance Pretty Term where pp :: Term -> Doc
pp = TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
Unqualified Integer
0

ppTerm :: TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
d (Abs BindType
b Ident
v Term
e)   = let ([(BindType, Ident)]
xs,Term
e') = Term -> ([(BindType, Ident)], Term)
getAbs (BindType -> Ident -> Term -> Term
Abs BindType
b Ident
v Term
e)
                           in t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (Char
'\\' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> ((BindType, Ident) -> Doc) -> [(BindType, Ident)] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct (BindType, Ident) -> Doc
forall a. Pretty a => (BindType, a) -> Doc
ppBind [(BindType, Ident)]
xs Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"->" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e')
ppTerm TermPrintQual
q t
d (T TInfo
TRaw [Case]
xs) = case Term -> ([Ident], Term)
getCTable (TInfo -> [Case] -> Term
T TInfo
TRaw [Case]
xs) of
                           ([],Term
_) -> FilePath
"table" FilePath -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                       SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Case -> Doc) -> [Case] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Case -> Doc
ppCase TermPrintQual
q) [Case]
xs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                     Char
'}'
                           ([Ident]
vs,Term
e) -> t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (FilePath
"\\\\" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> (Ident -> Doc) -> [Ident] -> Doc
forall a2 a. Pretty a2 => (a -> a2) -> [a] -> Doc
commaPunct Ident -> Doc
forall a. Pretty a => a -> Doc
pp [Ident]
vs Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"=>" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e)
ppTerm TermPrintQual
q t
d (T (TTyped Term
t) [Case]
xs) = FilePath
"table" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                 SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Case -> Doc) -> [Case] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Case -> Doc
ppCase TermPrintQual
q) [Case]
xs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                Char
'}'
ppTerm TermPrintQual
q t
d (T (TComp  Term
t) [Case]
xs) = FilePath
"table" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                 SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Case -> Doc) -> [Case] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Case -> Doc
ppCase TermPrintQual
q) [Case]
xs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                               Char
'}'
ppTerm TermPrintQual
q t
d (T (TWild  Term
t) [Case]
xs) = FilePath
"table" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                 SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Case -> Doc) -> [Case] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Case -> Doc
ppCase TermPrintQual
q) [Case]
xs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                Char
'}'
ppTerm TermPrintQual
q t
d (Prod BindType
bt Ident
x Term
a Term
b)= if Ident
x Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
identW Bool -> Bool -> Bool
&& BindType
bt BindType -> BindType -> Bool
forall a. Eq a => a -> a -> Bool
== BindType
Explicit
                              then t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
4 Term
a Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"->" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
b)
                              else t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (Doc -> Doc
forall a. Pretty a => a -> Doc
parens ((BindType, Ident) -> Doc
forall a. Pretty a => (BindType, a) -> Doc
ppBind (BindType
bt,Ident
x) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
a) Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"->" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
b)
ppTerm TermPrintQual
q t
d (Table Term
kt Term
vt)=t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
3 Term
kt Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"=>" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
vt)
ppTerm TermPrintQual
q t
d (Let LocalDef
l Term
e)    = let ([LocalDef]
ls,Term
e') = Term -> ([LocalDef], Term)
getLet Term
e
                          in t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (FilePath
"let" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat ((LocalDef -> Doc) -> [LocalDef] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> LocalDef -> Doc
ppLocDef TermPrintQual
q) (LocalDef
lLocalDef -> [LocalDef] -> [LocalDef]
forall a. a -> [a] -> [a]
:[LocalDef]
ls)) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ FilePath
"in" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e')
ppTerm TermPrintQual
q t
d (Example Term
e FilePath
s)=t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
0 (FilePath
"in" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
5 Term
e Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath -> Doc
forall a. Pretty a => a -> Doc
str FilePath
s)
ppTerm TermPrintQual
q t
d (C Term
e1 Term
e2)    =t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
1 (Doc -> SeqId -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> SeqId -> a2 -> Doc
hang (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
2 Term
e1) SeqId
2 (FilePath
"++" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
1 Term
e2))
ppTerm TermPrintQual
q t
d (Glue Term
e1 Term
e2) =t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
2 (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
3 Term
e1 Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'+'  Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
2 Term
e2)
ppTerm TermPrintQual
q t
d (S Term
x Term
y)     = case Term
x of
                           T TInfo
annot [Case]
xs -> let e :: Term
e = case TInfo
annot of
                                                   TInfo
TRaw     -> Term
y
                                                   TTyped Term
t -> Term -> Term -> Term
Typed Term
y Term
t
                                                   TComp  Term
t -> Term -> Term -> Term
Typed Term
y Term
t
                                                   TWild  Term
t -> Term -> Term -> Term
Typed Term
y Term
t
                                         in FilePath
"case" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>FilePath
"of" Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                            SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Case -> Doc) -> [Case] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Case -> Doc
ppCase TermPrintQual
q) [Case]
xs))) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                           Char
'}'
                           Term
_          -> t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
3 (Doc -> SeqId -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> SeqId -> a2 -> Doc
hang (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
3 Term
x) SeqId
2 (FilePath
"!" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
4 Term
y))
ppTerm TermPrintQual
q t
d (ExtR Term
x Term
y)  = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
3 (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
3 Term
x Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"**" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
4 Term
y)
ppTerm TermPrintQual
q t
d (App Term
x Term
y)   = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
4 Term
x Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
5 Term
y)
ppTerm TermPrintQual
q t
d (V Term
e [Term]
es)    = FilePath -> SeqId -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> SeqId -> a2 -> Doc
hang FilePath
"table" SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
sep [TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
6 Term
e,Doc -> Doc
forall a. Pretty a => a -> Doc
brackets ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Term -> Doc) -> [Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0) [Term]
es)))])
ppTerm TermPrintQual
q t
d (FV [Term]
es)     = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (FilePath
"variants" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Term -> Doc) -> [Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0) [Term]
es))))
ppTerm TermPrintQual
q t
d (AdHocOverload [Term]
es)     = FilePath
"overload" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Term -> Doc) -> [Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0) [Term]
es)))
ppTerm TermPrintQual
q t
d (Alts Term
e [(Term, Term)]
xs) = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (FilePath
"pre" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
braces (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
';' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' (((Term, Term) -> Doc) -> [(Term, Term)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> (Term, Term) -> Doc
ppAltern TermPrintQual
q) [(Term, Term)]
xs))))
ppTerm TermPrintQual
q t
d (Strs [Term]
es)   = FilePath
"strs" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' ((Term -> Doc) -> [Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0) [Term]
es)))
ppTerm TermPrintQual
q t
d (EPatt Patt
p)   = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (Char
'#' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
2 Patt
p)
ppTerm TermPrintQual
q t
d (EPattType Term
t)=t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (FilePath
"pattern" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t)
ppTerm TermPrintQual
q t
d (P Term
t Label
l)     = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
5 (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
5 Term
t Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'.' Doc -> Label -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Label
l)
ppTerm TermPrintQual
q t
d (Cn Ident
id)     = Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
id
ppTerm TermPrintQual
q t
d (Vr Ident
id)     = Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
id
ppTerm TermPrintQual
q t
d (Q  QIdent
id)     = TermPrintQual -> QIdent -> Doc
ppQIdent TermPrintQual
q QIdent
id
ppTerm TermPrintQual
q t
d (QC QIdent
id)     = TermPrintQual -> QIdent -> Doc
ppQIdent TermPrintQual
q QIdent
id
ppTerm TermPrintQual
q t
d (Sort Ident
id)   = Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
id
ppTerm TermPrintQual
q t
d (K FilePath
s)       = FilePath -> Doc
forall a. Pretty a => a -> Doc
str FilePath
s
ppTerm TermPrintQual
q t
d (EInt SeqId
n)    = SeqId -> Doc
forall a. Pretty a => a -> Doc
pp SeqId
n
ppTerm TermPrintQual
q t
d (EFloat Double
f)  = Double -> Doc
forall a. Pretty a => a -> Doc
pp Double
f
ppTerm TermPrintQual
q t
d (Meta SeqId
i)    = SeqId -> Doc
ppMeta SeqId
i
ppTerm TermPrintQual
q t
d (Term
Empty)     = FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
"[]"
ppTerm TermPrintQual
q t
d (R [])      = FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
"<>" -- to distinguish from {} empty RecType
ppTerm TermPrintQual
q t
d (R [Assign]
xs)      = Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' [Label
l Label -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
                                                       [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep [case Maybe Term
mb_t of {Just Term
t -> Char
':' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t; Maybe Term
Nothing -> Doc
empty},
                                                             Char
'=' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e] | (Label
l,(Maybe Term
mb_t,Term
e)) <- [Assign]
xs]))
ppTerm TermPrintQual
q t
d (RecType [Labelling]
xs)
  | TermPrintQual
q TermPrintQual -> TermPrintQual -> Bool
forall a. Eq a => a -> a -> Bool
== TermPrintQual
Terse         = case [FilePath
cat | (Label
l,Term
_) <- [Labelling]
xs, let (FilePath
p,FilePath
cat) = SeqId -> FilePath -> (FilePath, FilePath)
forall a. SeqId -> [a] -> ([a], [a])
splitAt SeqId
5 (Ident -> FilePath
showIdent (Label -> Ident
label2ident Label
l)), FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"lock_"] of
                           [FilePath
cat] -> FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
cat
                           [FilePath]
_     -> Doc
doc
  | Bool
otherwise          = Doc
doc
  where
    doc :: Doc
doc = Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' [Label
l Label -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t | (Label
l,Term
t) <- [Labelling]
xs]))
ppTerm TermPrintQual
q t
d (Typed Term
e Term
t) = Char
'<' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'>'
ppTerm TermPrintQual
q t
d (ImplArg Term
e) = Doc -> Doc
forall a. Pretty a => a -> Doc
braces (TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e)
ppTerm TermPrintQual
q t
d (ELincat Ident
cat Term
t) = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (FilePath
"lincat" FilePath -> Ident -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Ident
cat Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
5 Term
t)
ppTerm TermPrintQual
q t
d (ELin Ident
cat Term
t) = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (FilePath
"lin" FilePath -> Ident -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Ident
cat Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
5 Term
t)
ppTerm TermPrintQual
q t
d (Error FilePath
s)   = t -> t -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec t
d t
4 (FilePath
"Predef.error" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath -> Doc
forall a. Pretty a => a -> Doc
str FilePath
s)

ppEquation :: TermPrintQual -> Equation -> Doc
ppEquation TermPrintQual
q ([Patt]
ps,Term
e) = [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat ((Patt -> Doc) -> [Patt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> Integer -> Patt -> Doc
forall a. (Num a, Ord a) => TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q Integer
2) [Patt]
ps) Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"->" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
e

ppCase :: TermPrintQual -> Case -> Doc
ppCase TermPrintQual
q (Patt
p,Term
e) = TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
0 Patt
p Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"=>" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e

instance Pretty Patt where pp :: Patt -> Doc
pp = TermPrintQual -> Integer -> Patt -> Doc
forall a. (Num a, Ord a) => TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
Unqualified Integer
0

ppPatt :: TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
d (PAlt Patt
p1 Patt
p2) = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
0 (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
0 Patt
p1 Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'|' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
1 Patt
p2)
ppPatt TermPrintQual
q a
d (PSeq Patt
p1 Patt
p2) = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
0 (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
0 Patt
p1 Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'+' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
1 Patt
p2)
ppPatt TermPrintQual
q a
d (PMSeq ((SeqId, SeqId)
_,Patt
p1) ((SeqId, SeqId)
_,Patt
p2)) = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
0 (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
0 Patt
p1 Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'+' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
1 Patt
p2)
ppPatt TermPrintQual
q a
d (PC Ident
f [Patt]
ps)    = if [Patt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Patt]
ps
                            then Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
f
                            else a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
1 (Ident
f Ident -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep ((Patt -> Doc) -> [Patt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
3) [Patt]
ps))
ppPatt TermPrintQual
q a
d (PP QIdent
f [Patt]
ps)    = if [Patt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Patt]
ps
                            then TermPrintQual -> QIdent -> Doc
ppQIdent TermPrintQual
q QIdent
f
                            else a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
1 (TermPrintQual -> QIdent -> Doc
ppQIdent TermPrintQual
q QIdent
f Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep ((Patt -> Doc) -> [Patt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
3) [Patt]
ps))
ppPatt TermPrintQual
q a
d (PRep Patt
p)     = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
1 (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
3 Patt
p Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'*')
ppPatt TermPrintQual
q a
d (PAs Ident
f Patt
p)    = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
2 (Ident
f Ident -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'@' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
3 Patt
p)
ppPatt TermPrintQual
q a
d (PNeg Patt
p)     = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
2 (Char
'-' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
3 Patt
p)
ppPatt TermPrintQual
q a
d (Patt
PChar)      = Char -> Doc
forall a. Pretty a => a -> Doc
pp Char
'?'
ppPatt TermPrintQual
q a
d (PChars FilePath
s)   = Doc -> Doc
forall a. Pretty a => a -> Doc
brackets (FilePath -> Doc
forall a. Pretty a => a -> Doc
str FilePath
s)
ppPatt TermPrintQual
q a
d (PMacro Ident
id)  = Char
'#' Char -> Ident -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Ident
id
ppPatt TermPrintQual
q a
d (PM QIdent
id)      = Char
'#' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> QIdent -> Doc
ppQIdent TermPrintQual
q QIdent
id
ppPatt TermPrintQual
q a
d Patt
PW           = Char -> Doc
forall a. Pretty a => a -> Doc
pp Char
'_'
ppPatt TermPrintQual
q a
d (PV Ident
id)      = Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
id
ppPatt TermPrintQual
q a
d (PInt SeqId
n)     = SeqId -> Doc
forall a. Pretty a => a -> Doc
pp SeqId
n
ppPatt TermPrintQual
q a
d (PFloat Double
f)   = Double -> Doc
forall a. Pretty a => a -> Doc
pp Double
f
ppPatt TermPrintQual
q a
d (PString FilePath
s)  = FilePath -> Doc
forall a. Pretty a => a -> Doc
str FilePath
s
ppPatt TermPrintQual
q a
d (PR [(Label, Patt)]
xs)      = Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
';' [Label
l Label -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
0 Patt
e | (Label
l,Patt
e) <- [(Label, Patt)]
xs]))
ppPatt TermPrintQual
q a
d (PImplArg Patt
p) = Doc -> Doc
forall a. Pretty a => a -> Doc
braces (TermPrintQual -> a -> Patt -> Doc
ppPatt TermPrintQual
q a
0 Patt
p)
ppPatt TermPrintQual
q a
d (PTilde Term
t)   = a -> a -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec a
d a
2 (Char
'~' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
6 Term
t)

ppValue :: TermPrintQual -> Int -> Val -> Doc
ppValue :: TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
q SeqId
d (VGen SeqId
i Ident
x)    = Ident
x Ident -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> FilePath
"{-" Doc -> SeqId -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> SeqId
i Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> FilePath
"-}" ---- latter part for debugging
ppValue TermPrintQual
q SeqId
d (VApp Val
u Val
v)    = SeqId -> SeqId -> Doc -> Doc
forall a. Ord a => a -> a -> Doc -> Doc
prec SeqId
d SeqId
4 (TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
q SeqId
4 Val
u Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
q SeqId
5 Val
v)
ppValue TermPrintQual
q SeqId
d (VCn (ModuleName
_,Ident
c))   = Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
c
ppValue TermPrintQual
q SeqId
d (VClos Env
env Term
e) = case Term
e of
                              Meta SeqId
_ -> TermPrintQual -> SeqId -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q SeqId
d Term
e Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Env -> Doc
ppEnv Env
env
                              Term
_      -> TermPrintQual -> SeqId -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q SeqId
d Term
e ---- ++ prEnv env ---- for debugging
ppValue TermPrintQual
q SeqId
d (VRecType [(Label, Val)]
xs) = Doc -> Doc
forall a. Pretty a => a -> Doc
braces ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (Char -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate Char
',' [Label
l Label -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
q SeqId
0 Val
v | (Label
l,Val
v) <- [(Label, Val)]
xs]))
ppValue TermPrintQual
q SeqId
d Val
VType         = FilePath -> Doc
forall a. Pretty a => a -> Doc
pp FilePath
"Type"

ppConstrs :: Constraints -> [Doc]
ppConstrs :: Constraints -> [Doc]
ppConstrs = ((Val, Val) -> Doc) -> Constraints -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Val
v,Val
w) -> Doc -> Doc
forall a. Pretty a => a -> Doc
braces (TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
Unqualified SeqId
0 Val
v Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"<>" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
Unqualified SeqId
0 Val
w))

ppEnv :: Env -> Doc
ppEnv :: Env -> Doc
ppEnv Env
e = [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat (((Ident, Val) -> Doc) -> Env -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Ident
x,Val
t) -> Doc -> Doc
forall a. Pretty a => a -> Doc
braces (Ident
x Ident -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> FilePath
":=" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> TermPrintQual -> SeqId -> Val -> Doc
ppValue TermPrintQual
Unqualified SeqId
0 Val
t)) Env
e)

str :: a -> Doc
str a
s = a -> Doc
forall a. Pretty a => a -> Doc
doubleQuotes a
s

ppDecl :: TermPrintQual -> (a, Ident, Term) -> Doc
ppDecl TermPrintQual
q (a
_,Ident
id,Term
typ)
  | Ident
id Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
identW = TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
3 Term
typ
  | Bool
otherwise    = Doc -> Doc
forall a. Pretty a => a -> Doc
parens (Ident
id Ident -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
typ)

ppDDecl :: TermPrintQual -> (a, Ident, Term) -> Doc
ppDDecl TermPrintQual
q (a
_,Ident
id,Term
typ)
  | Ident
id Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
identW = TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
6 Term
typ
  | Bool
otherwise    = Doc -> Doc
forall a. Pretty a => a -> Doc
parens (Ident
id Ident -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> Integer -> Term -> Doc
forall t. (Ord t, Num t) => TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q Integer
0 Term
typ)

ppQIdent :: TermPrintQual -> QIdent -> Doc
ppQIdent :: TermPrintQual -> QIdent -> Doc
ppQIdent TermPrintQual
q (ModuleName
m,Ident
id) =
  case TermPrintQual
q of
    TermPrintQual
Terse       ->          Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
id
    TermPrintQual
Unqualified ->          Ident -> Doc
forall a. Pretty a => a -> Doc
pp Ident
id
    TermPrintQual
Qualified   -> ModuleName
m ModuleName -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'.' Doc -> Ident -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Ident
id
    TermPrintQual
Internal    -> ModuleName
m ModuleName -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
'.' Doc -> Ident -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Ident
id


instance Pretty Label where pp :: Label -> Doc
pp = Ident -> Doc
forall a. Pretty a => a -> Doc
pp (Ident -> Doc) -> (Label -> Ident) -> Label -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Ident
label2ident

ppOpenSpec :: OpenSpec -> Doc
ppOpenSpec (OSimple ModuleName
id)   = ModuleName -> Doc
forall a. Pretty a => a -> Doc
pp ModuleName
id
ppOpenSpec (OQualif ModuleName
id ModuleName
n) = Doc -> Doc
forall a. Pretty a => a -> Doc
parens (ModuleName
id ModuleName -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> ModuleName -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> ModuleName
n)

ppInstSpec :: (a1, a2) -> Doc
ppInstSpec (a1
id,a2
n) = Doc -> Doc
forall a. Pretty a => a -> Doc
parens (a1
id a1 -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
n)

ppLocDef :: TermPrintQual -> LocalDef -> Doc
ppLocDef TermPrintQual
q (Ident
id, (Maybe Term
mbt, Term
e)) =
  Ident
id Ident -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>
  (case Maybe Term
mbt of {Just Term
t -> Char
':' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
t; Maybe Term
Nothing -> Doc
empty} Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'=' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
e) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
';'

ppBind :: (BindType, a) -> Doc
ppBind (BindType
Explicit,a
v) = a -> Doc
forall a. Pretty a => a -> Doc
pp a
v
ppBind (BindType
Implicit,a
v) = a -> Doc
forall a. Pretty a => a -> Doc
braces a
v

ppAltern :: TermPrintQual -> (Term, Term) -> Doc
ppAltern TermPrintQual
q (Term
x,Term
y) = TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
x Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'/' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> TermPrintQual -> t -> Term -> Doc
ppTerm TermPrintQual
q t
0 Term
y

ppParams :: TermPrintQual -> [(a1, [(a, Ident, Term)])] -> Doc
ppParams TermPrintQual
q [(a1, [(a, Ident, Term)])]
ps = [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
fsep (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
forall a. Pretty a => a -> Doc
pp Char
'|') (((a1, [(a, Ident, Term)]) -> Doc)
-> [(a1, [(a, Ident, Term)])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> (a1, [(a, Ident, Term)]) -> Doc
forall a1 a.
Pretty a1 =>
TermPrintQual -> (a1, [(a, Ident, Term)]) -> Doc
ppParam TermPrintQual
q) [(a1, [(a, Ident, Term)])]
ps))
ppParam :: TermPrintQual -> (a1, [(a, Ident, Term)]) -> Doc
ppParam TermPrintQual
q (a1
id,[(a, Ident, Term)]
cxt) = a1
id a1 -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (((a, Ident, Term) -> Doc) -> [(a, Ident, Term)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TermPrintQual -> (a, Ident, Term) -> Doc
forall a. TermPrintQual -> (a, Ident, Term) -> Doc
ppDDecl TermPrintQual
q) [(a, Ident, Term)]
cxt)

ppProduction :: Production -> Doc
ppProduction (Production SeqId
fid SeqId
funid [[SeqId]]
args) =
  SeqId -> Doc
ppFId SeqId
fid Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"->" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> SeqId -> Doc
ppFunId SeqId
funid Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<>
  Doc -> Doc
forall a. Pretty a => a -> Doc
brackets ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat (FilePath -> [Doc] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate FilePath
"," (([SeqId] -> Doc) -> [[SeqId]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hsep ([Doc] -> Doc) -> ([SeqId] -> [Doc]) -> [SeqId] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
forall a. Pretty a => a -> Doc
pp Char
'|') ([Doc] -> [Doc]) -> ([SeqId] -> [Doc]) -> [SeqId] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SeqId -> Doc) -> [SeqId] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SeqId -> Doc
ppFId) [[SeqId]]
args)))

ppSequences :: TermPrintQual -> a SeqId (a i Symbol) -> Doc
ppSequences TermPrintQual
q a SeqId (a i Symbol)
seqsArr
  | [(SeqId, a i Symbol)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SeqId, a i Symbol)]
seqs Bool -> Bool -> Bool
|| TermPrintQual
q TermPrintQual -> TermPrintQual -> Bool
forall a. Eq a => a -> a -> Bool
/= TermPrintQual
Internal = Doc
empty
  | Bool
otherwise                  = FilePath
"sequences" FilePath -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Char
'{' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                 SeqId -> Doc -> Doc
forall a. Pretty a => SeqId -> a -> Doc
nest SeqId
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (((SeqId, a i Symbol) -> Doc) -> [(SeqId, a i Symbol)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (SeqId, a i Symbol) -> Doc
forall (a :: * -> * -> *) i.
(IArray a Symbol, Ix i) =>
(SeqId, a i Symbol) -> Doc
ppSeq [(SeqId, a i Symbol)]
seqs)) Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                 Char
'}'
  where
    seqs :: [(SeqId, a i Symbol)]
seqs = a SeqId (a i Symbol) -> [(SeqId, a i Symbol)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs a SeqId (a i Symbol)
seqsArr

commaPunct :: (a -> a2) -> [a] -> Doc
commaPunct a -> a2
f [a]
ds = ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat (FilePath -> [a2] -> [Doc]
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> [a2] -> [Doc]
punctuate FilePath
"," ((a -> a2) -> [a] -> [a2]
forall a b. (a -> b) -> [a] -> [b]
map a -> a2
f [a]
ds)))

prec :: a -> a -> Doc -> Doc
prec a
d1 a
d2 Doc
doc
  | a
d1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
d2   = Doc -> Doc
forall a. Pretty a => a -> Doc
parens Doc
doc
  | Bool
otherwise = Doc
doc

getAbs :: Term -> ([(BindType,Ident)], Term)
getAbs :: Term -> ([(BindType, Ident)], Term)
getAbs (Abs BindType
bt Ident
v Term
e) = let ([(BindType, Ident)]
xs,Term
e') = Term -> ([(BindType, Ident)], Term)
getAbs Term
e
                      in ((BindType
bt,Ident
v)(BindType, Ident) -> [(BindType, Ident)] -> [(BindType, Ident)]
forall a. a -> [a] -> [a]
:[(BindType, Ident)]
xs,Term
e')
getAbs Term
e            = ([],Term
e)

getCTable :: Term -> ([Ident], Term)
getCTable :: Term -> ([Ident], Term)
getCTable (T TInfo
TRaw [(PV Ident
v,Term
e)]) = let ([Ident]
vs,Term
e') = Term -> ([Ident], Term)
getCTable Term
e
                                in (Ident
vIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
vs,Term
e')
getCTable (T TInfo
TRaw [(Patt
PW,  Term
e)]) = let ([Ident]
vs,Term
e') = Term -> ([Ident], Term)
getCTable Term
e
                                in (Ident
identWIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
vs,Term
e')
getCTable Term
e                   = ([],Term
e)

getLet :: Term -> ([LocalDef], Term)
getLet :: Term -> ([LocalDef], Term)
getLet (Let LocalDef
l Term
e) = let ([LocalDef]
ls,Term
e') = Term -> ([LocalDef], Term)
getLet Term
e
                   in (LocalDef
lLocalDef -> [LocalDef] -> [LocalDef]
forall a. a -> [a] -> [a]
:[LocalDef]
ls,Term
e')
getLet Term
e         = ([],Term
e)