PrintAs.hs revision 43a582fe35884e2c6f455e7bfa34f0f4ef8dfe2e
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceModule : $Header$
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceDescription : print the abstract syntax so that it can be re-parsed
81ec673ac5ab1493568d9ef7798b752ab8ee0e61Felix Gabriel ManceCopyright : (c) Christian Maeder and Uni Bremen 2003
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceMaintainer : Christian.Maeder@dfki.de
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceStability : experimental
5d801400993c9671010d244646936d8fd435638cChristian MaederPortability : portable
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Manceprinting data types of the abstract syntax
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel Manceimport qualified Data.Set as Set
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel Mance-- | short cut for: if b then empty else d
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel MancenoPrint :: Bool -> Doc -> Doc
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel MancenoPrint b d = if b then empty else d
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel MancenoNullPrint :: [a] -> Doc -> Doc
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel MancenoNullPrint = noPrint . null
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel MancesemiDs :: Pretty a => [a] -> Doc
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel MancesemiDs = fsep . punctuate semi . map pretty
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel MancesemiAnnoted :: Pretty a => [Annoted a] -> Doc
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel MancesemiAnnoted = vcat . map (printSemiAnno pretty True)
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Manceinstance Pretty Variance where
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance pretty = sidDoc . mkSimpleId . show
0ec1551231bc5dfdcb3f2bd68fec7457fade7bfdFelix Gabriel Manceinstance Pretty a => Pretty (AnyKind a) where
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance pretty knd = case knd of
852bd6145634dc2832b61c44678fe539bc1682d5Christian Maeder ClassKind ci -> pretty ci
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder FunKind v k1 k2 _ -> fsep
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance [ pretty v <> (case k1 of
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance FunKind _ _ _ _ -> parens
6033265e7b4ae660eff78e944213286863304903Mihai Codescu _ -> id) (pretty k1)
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance , funArrow, pretty k2]
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel MancevarOfTypeArg :: TypeArg -> Id
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel MancevarOfTypeArg (TypeArg i _ _ _ _ _ _) = i
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Manceinstance Pretty TypePattern where
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder pretty tp = case tp of
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder TypePattern name@(Id ts cs _) args _ ->
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder let ds = map (pretty . varOfTypeArg) args in
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder if placeCount name == length args then
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder let (ras, dts) = mapAccumL ( \ l t -> if isPlace t then
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder x : r -> (r, x)
fc7bd98aabe1bc26058660085e8c77d60a97bcecChristian Maeder _ -> error "Pretty TypePattern"
fc7bd98aabe1bc26058660085e8c77d60a97bcecChristian Maeder else (l, printTypeToken t)) ds ts
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder in fsep $ dts ++ (if null cs then [] else
fc7bd98aabe1bc26058660085e8c77d60a97bcecChristian Maeder [brackets $ sepByCommas $ map printTypeId cs])
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder else printTypeId name <+> fsep ds
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance TypePatternToken t -> printTypeToken t
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance MixfixTypePattern ts -> fsep $ map pretty ts
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance BracketTypePattern k l _ -> bracket k $ ppWithCommas l
852bd6145634dc2832b61c44678fe539bc1682d5Christian Maeder TypePatternArg t _ -> parens $ pretty t
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance-- | put proper brackets around a document
c4ca03cce9571a309b1c173e9d5d27fdb8843abdChristian Maederbracket :: BracketKind -> Doc -> Doc
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mancebracket b = case b of
407f3d9049715c5d96f014a5a1776410e034db83Christian Maeder Parens -> parens
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance Squares -> brackets
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance Braces -> specBraces
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel Mance NoBrackets -> id
544989bc1f6ed4bc0813334ffd934db0fb0010eaFelix Gabriel Mance-- | print a 'Kind' plus a preceding colon (or nothing)
544989bc1f6ed4bc0813334ffd934db0fb0010eaFelix Gabriel ManceprintKind :: Kind -> Doc
544989bc1f6ed4bc0813334ffd934db0fb0010eaFelix Gabriel ManceprintKind k = noPrint (k == universe) $ printVarKind NonVar (VarKind k)
544989bc1f6ed4bc0813334ffd934db0fb0010eaFelix Gabriel Mance-- | print the kind of a variable with its variance and a preceding colon
f8c3d045dda224e92bf6bcb6288e1ee75ab54d1eChristian MaederprintVarKind :: Variance -> VarKind -> Doc
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian MaederprintVarKind e vk = case vk of
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder Downset t -> less <+> pretty t
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder VarKind k -> colon <+> pretty e <> pretty k
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder MissingKind -> empty
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mancedata TypePrec = Outfix | Prefix | Lazyfix | ProdInfix | FunInfix | Absfix
f8c3d045dda224e92bf6bcb6288e1ee75ab54d1eChristian Maeder deriving (Eq, Ord)
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceparenPrec :: TypePrec -> (TypePrec, Doc) -> Doc
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel ManceparenPrec p1 (p2, d) = if p2 < p1 then d else parens d
852bd6145634dc2832b61c44678fe539bc1682d5Christian MaederprintTypeToken :: Token -> Doc
852bd6145634dc2832b61c44678fe539bc1682d5Christian MaederprintTypeToken t = let
852bd6145634dc2832b61c44678fe539bc1682d5Christian Maeder l = ("*", cross) : map ( \ (a, d) -> (show a, d) )
ea3f858eb531d981df3ed00beeadd99cf025adecChristian Maeder [ (FunArr, funArrow)
ea3f858eb531d981df3ed00beeadd99cf025adecChristian Maeder , (PFunArr, pfun)
ea3f858eb531d981df3ed00beeadd99cf025adecChristian Maeder , (ContFunArr, cfun)
75aaf82c430ad2a5cf159962b1c5c09255010fb4Felix Gabriel Mance , (PContFunArr, pcfun) ]
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel Mance in case lookup (tokStr t) l of
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel ManceprintTypeId :: Id -> Doc
1b1144abf7f95a4b23405b8d5604813cfe7b036aFelix Gabriel ManceprintTypeId (Id ts cs _) = let (toks, pls) = splitMixToken ts in
19e01e1a7e319063434bd86c8ecbc5f241ef9993Felix Gabriel Mance fcat $ map printTypeToken toks
1b1144abf7f95a4b23405b8d5604813cfe7b036aFelix Gabriel Mance ++ (if null cs then [] else [brackets $ sepByCommas $ map printTypeId cs])
5a3ae0a9224276de25e709ef8788c1b9716cd206Christian Maeder ++ map printTypeToken pls
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel MancetoMixType :: Type -> (TypePrec, Doc)
668c9c725a11c0f77057152148570af853a1bc0dFelix Gabriel MancetoMixType typ = case typ of
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance TypeName name _ _ -> (Outfix, printTypeId name)
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance TypeToken tt -> (Outfix, printTypeToken tt)
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance TypeAbs v t _ ->
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance (Absfix, sep [ lambda <+> pretty v, bullet <+> snd (toMixType t)])
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance ExpandedType t1 _ -> toMixType t1 -- here we print the unexpanded type
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance BracketType k l _ ->
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance (Outfix, bracket k $ sepByCommas $ map (snd . toMixType) l)
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance KindedType t kind _ -> (Lazyfix, sep
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance [ parenPrec Lazyfix $ toMixType t
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance , colon <+> printList0 (Set.toList kind)])
1b90322eaf59ded3de24fc891bd67bbd73ec2bfaFelix Gabriel Mance MixfixType ts -> (Prefix, fsep $ map (snd . toMixType) ts)
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance TypeAppl t1 t2 -> let
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance (topTy, tyArgs) = getTypeApplAux False typ
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance aArgs = (Prefix, sep [ parenPrec ProdInfix $ toMixType t1
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance , parenPrec Prefix $ toMixType t2 ])
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance in case topTy of
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance TypeName name@(Id ts cs _) _k _i ->
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance case map toMixType tyArgs of
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance [dArg] -> case ts of
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance [e] | name == lazyTypeId ->
9cb6af1a7632f12b60f592ce5eb2ac51e6bd33bbFelix Gabriel Mance (Lazyfix, pretty e <+> parenPrec Lazyfix dArg)
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance [e1, e2, e3] | not (isPlace e1) && isPlace e2
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance && not (isPlace e3) && null cs ->
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder (Outfix, fsep [pretty e1, snd dArg, pretty e3])
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance [dArg1, dArg2] -> case ts of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance [_, e2, _] | isInfix name && null cs ->
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance if tokStr e2 == prodS then
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance (ProdInfix, fsep
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance [ parenPrec ProdInfix dArg1
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance , cross, parenPrec ProdInfix dArg2])
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder else -- assume fun type
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance (FunInfix, fsep
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance [ parenPrec FunInfix dArg1
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance , printTypeToken e2, snd dArg2])
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance dArgs -> if isProductIdWithArgs name $ length tyArgs then
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance (ProdInfix, fsep $ punctuate (space <> cross) $
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance map (parenPrec ProdInfix) dArgs) else aArgs
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Manceinstance Pretty Type where
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance pretty = snd . toMixType
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel ManceprintTypeScheme :: PolyId -> TypeScheme -> Doc
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel ManceprintTypeScheme (PolyId _ tys _) (TypeScheme vs t _) =
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance let tdoc = pretty t in
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance if null vs || not (null tys) then tdoc else
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance fsep [forallDoc, semiDs vs, bullet <+> tdoc]
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance-- no curried notation for bound variables
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Manceinstance Pretty TypeScheme where
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance pretty = printTypeScheme (PolyId applId [] nullRange)
1a38107941725211e7c3f051f7a8f5e12199f03acmaederinstance Pretty Partiality where
a921ae1da1302f673204e7b63cdce01439a9bd5eFelix Gabriel Mance pretty p = case p of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance Partial -> quMarkD
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance Total -> empty
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Manceinstance Pretty Quantifier where
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance pretty q = case q of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance Universal -> forallDoc
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance Existential -> exists
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance Unique -> unique
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Manceinstance Pretty TypeQual where
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance pretty q = case q of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance OfType -> colon
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance AsType -> text asS
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance InType -> inDoc
097bc9f18b722812d480df0f5c634d09cbca8e21Felix Gabriel Mance Inferred -> colon
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Manceinstance Pretty Term where
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance pretty = printTerm . rmSomeTypes
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel ManceisSimpleTerm :: Term -> Bool
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceisSimpleTerm trm = case trm of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance QualVar _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance QualOp _ _ _ _ _ _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance ResolvedMixTerm _ _ _ _ -> True
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance ApplTerm _ _ _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance TupleTerm _ _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance TermToken _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance BracketTerm _ _ _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance-- | used only to produce CASL applications
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceisSimpleArgTerm :: Term -> Bool
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceisSimpleArgTerm trm = case trm of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance QualVar vd -> not (isPatVarDecl vd)
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder QualOp _ _ _ _ _ _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance ResolvedMixTerm n _ l _ -> placeCount n /= 0 || not (null l)
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Mance TupleTerm _ _ -> True
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder BracketTerm _ _ _ -> True
1a38107941725211e7c3f051f7a8f5e12199f03acmaederhasRightQuant :: Term -> Bool
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel MancehasRightQuant t = case t of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance QuantifiedTerm {} -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance LambdaTerm {} -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance CaseTerm {} -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance LetTerm Let _ _ _ -> True
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance ResolvedMixTerm n _ ts _ | endPlace n && placeCount n == length ts
083b2687afdb676237f926bdb643b24027291d05Felix Gabriel Mance -> hasRightQuant (last ts)
511be329b2e8f55d0c6b18bd92571a1776b15932Felix Gabriel Mance ApplTerm (ResolvedMixTerm n _ [] _) t2 _ | endPlace n ->
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder TupleTerm ts _ | placeCount n == length ts -> hasRightQuant (last ts)
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder _ -> hasRightQuant t2
511be329b2e8f55d0c6b18bd92571a1776b15932Felix Gabriel Mance ApplTerm _ t2 _ -> hasRightQuant t2
e26bfed39ffa184453272125a4adf147206eac74Christian MaederzipArgs :: Id -> [Term] -> [Doc] -> [Doc]
e26bfed39ffa184453272125a4adf147206eac74Christian MaederzipArgs n ts ds = case (ts, ds) of
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance (t : r, d : s) -> let
0c3badd7ad83eb89f64ef5ed1122c4fa856fb45dFelix Gabriel Mance p = parenTermDoc t d
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder e = if hasRightQuant t then parens d else p
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder in if null r && null s && endPlace n then
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder [if hasRightQuant t then d else p]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder else e : zipArgs n r s
e26bfed39ffa184453272125a4adf147206eac74Christian MaederisPatVarDecl :: VarDecl -> Bool
e26bfed39ffa184453272125a4adf147206eac74Christian MaederisPatVarDecl (VarDecl v ty _ _) = case ty of
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder TypeName t _ _ -> isSimpleId v && isPrefixOf "_v" (show t)
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel ManceparenTermDoc :: Term -> Doc -> Doc
e26bfed39ffa184453272125a4adf147206eac74Christian MaederparenTermDoc trm = if isSimpleTerm trm then id else parens
e26bfed39ffa184453272125a4adf147206eac74Christian MaederprintTermRec :: FoldRec Doc (Doc, Doc)
e26bfed39ffa184453272125a4adf147206eac74Christian MaederprintTermRec = FoldRec
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel Mance { foldQualVar = \ _ vd@(VarDecl v _ _ _) ->
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel Mance if isPatVarDecl vd then pretty v
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder else parens $ keyword varS <+> pretty vd
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel Mance , foldQualOp = \ _ br n t tys k _ ->
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance (if null tys || k == Infer then id else
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel Mance (<> brackets (ppWithCommas tys))) $
511be329b2e8f55d0c6b18bd92571a1776b15932Felix Gabriel Mance parens $ fsep [pretty br, pretty n, colon, printTypeScheme n $
6504b297e21d071d8fada2f732cabb6d8f7d38a2Felix Gabriel Mance if isPred br then unPredTypeScheme t else t]
6504b297e21d071d8fada2f732cabb6d8f7d38a2Felix Gabriel Mance , foldResolvedMixTerm =
6504b297e21d071d8fada2f732cabb6d8f7d38a2Felix Gabriel Mance \ (ResolvedMixTerm _ _ os _) n@(Id toks cs ps) tys ts _ ->
6504b297e21d071d8fada2f732cabb6d8f7d38a2Felix Gabriel Mance let pn = placeCount n in if pn == length ts || null ts then
f8c3d045dda224e92bf6bcb6288e1ee75ab54d1eChristian Maeder let ds = zipArgs n os ts in
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder if null tys then idApplDoc n ds
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder else let (ftoks, _) = splitMixToken toks
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder fId = Id ftoks cs ps
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder (fts, rts) = splitAt (placeCount fId) $ if null ts
4b7c9b9fec53befb553f2c9b11e30a4fe2235e03Felix Gabriel Mance then replicate pn $ pretty placeTok else ds
44985cbd4eb61dbc348617ebdd44a774e51dac07Christian Maeder in fsep $ (idApplDoc fId fts <> brackets (ppWithCommas tys))
1075744775ba70c9ef6cdd06523204751f544ed5Christian Maeder else idApplDoc applId [idDoc n, parens $ sepByCommas ts]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , foldApplTerm = \ (ApplTerm o1 o2 _) t1 t2 _ ->
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder case (o1, o2) of
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder -- comment out the following two guards for CASL applications
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder (ResolvedMixTerm n _ [] _, TupleTerm ts@(_ : _) _)
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder | placeCount n == length ts ->
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder idApplDoc n (zipArgs n ts $ map printTerm ts)
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder (ResolvedMixTerm n _ [] _, _) | placeCount n == 1
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder -> idApplDoc n $ zipArgs n [o2] [t2]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder _ -> idApplDoc applId $ zipArgs applId [o1, o2] [t1, t2]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , foldTupleTerm = \ _ ts _ -> parens $ sepByCommas ts
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder , foldTypedTerm = \ (TypedTerm ot _ _ _) t q typ _ -> fsep [(case ot of
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder TypedTerm {} | elem q [Inferred, OfType] -> parens
1075744775ba70c9ef6cdd06523204751f544ed5Christian Maeder ApplTerm (ResolvedMixTerm n _ [] _) arg _ ->
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder let pn = placeCount n in case arg of
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder TupleTerm ts@(_ : _) _ | pn == length ts -> parens
f8c3d045dda224e92bf6bcb6288e1ee75ab54d1eChristian Maeder _ | pn == 1 || hasRightQuant ot -> parens
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder _ | hasRightQuant ot -> parens
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder _ -> id) t, pretty q, pretty typ]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , foldQuantifiedTerm = \ _ q vs t _ ->
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder fsep [pretty q, printGenVarDecls vs, bullet <+> t]
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder , foldLambdaTerm = \ (LambdaTerm ops _ _ _) ps q t _ ->
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder fsep [ lambda
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , case ops of
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder [p] -> case p of
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder TupleTerm [] _ -> empty
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder QualVar vd@(VarDecl v ty _ _) ->
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder pretty v <+> if isPatVarDecl vd then empty
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder else printVarDeclType ty
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder _ -> if all ( \ p -> case p of
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder QualVar vd -> not $ isPatVarDecl vd
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder _ -> False) ops
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder then printGenVarDecls $ map
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder ( \ (QualVar vd) -> GenVarDecl vd) ops
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder else fcat $ map parens ps
6856a07e36551ed6fadd7c01e7152a3a28878a6fChristian Maeder Partial -> bullet
f8c3d045dda224e92bf6bcb6288e1ee75ab54d1eChristian Maeder Total -> bullet <> text exMark) <+> t]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , foldCaseTerm = \ _ t es _ ->
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder fsep [text caseS, t, text ofS,
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance cat $ punctuate (space <> bar <> space) $
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder map (printEq0 funArrow) es]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , foldLetTerm = \ _ br es t _ ->
44985cbd4eb61dbc348617ebdd44a774e51dac07Christian Maeder let des = sep $ punctuate semi $ map (printEq0 equals) es
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance Let -> fsep [sep [text letS <+> des, text inS], t]
1075744775ba70c9ef6cdd06523204751f544ed5Christian Maeder Where -> fsep [sep [t, text whereS], des]
1075744775ba70c9ef6cdd06523204751f544ed5Christian Maeder Program -> text programS <+> des
1075744775ba70c9ef6cdd06523204751f544ed5Christian Maeder , foldTermToken = const pretty
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldMixTypeTerm = \ _ q t _ -> pretty q <+> pretty t
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldMixfixTerm = const fsep
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldBracketTerm = \ _ k l _ -> bracket k $ sepByCommas l
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldAsPattern = \ _ (VarDecl v _ _ _) p _ ->
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance fsep [pretty v, text asP, p]
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel Mance , foldProgEq = \ _ p t _ -> (p, t) }
d850dba73b02f345f64a3546d0f0299c292f88d6Felix Gabriel ManceprintTerm :: Term -> Doc
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel ManceprintTerm = foldTerm printTermRec
4b7c9b9fec53befb553f2c9b11e30a4fe2235e03Felix Gabriel MancermTypeRec :: MapRec
4b7c9b9fec53befb553f2c9b11e30a4fe2235e03Felix Gabriel MancermTypeRec = mapRec
4b7c9b9fec53befb553f2c9b11e30a4fe2235e03Felix Gabriel Mance { foldQualOp = \ t _ (PolyId i _ _) _ tys k ps ->
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance if elem i $ map fst bList then ResolvedMixTerm i
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance (if k == Infer then [] else tys) [] ps else t
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldTypedTerm = \ _ nt q ty ps -> case q of
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance Inferred -> nt
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance _ -> case nt of
0c3badd7ad83eb89f64ef5ed1122c4fa856fb45dFelix Gabriel Mance TypedTerm tt oq oty _ | oty == ty || oq == InType ->
771c32080c77497c6c023a3b1c422f7daf3773f7Felix Gabriel Mance if q == AsType then TypedTerm tt q ty ps else nt
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance QualVar (VarDecl _ oty _ _) | oty == ty -> nt
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance _ -> TypedTerm nt q ty ps }
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel MancermSomeTypes :: Term -> Term
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian MaederrmSomeTypes = foldTerm rmTypeRec
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder-- | put parenthesis around applications
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian MaederparenTermRec :: MapRec
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian MaederparenTermRec = let
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder addParAppl t = case t of
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder ResolvedMixTerm _ _ [] _ -> t
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder QualVar _ -> t
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder QualOp _ _ _ _ _ _ -> t
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder TermToken _ -> t
669b3375925f7a145d287fa89f3a815708dbe7a1Christian Maeder BracketTerm _ _ _ -> t
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder TupleTerm _ _ -> t
a03c109eabfe250e4b57bdf44f37f53751a65df4Felix Gabriel Mance _ -> TupleTerm [t] nullRange
a03c109eabfe250e4b57bdf44f37f53751a65df4Felix Gabriel Mance { foldApplTerm = \ _ t1 t2 ->
a03c109eabfe250e4b57bdf44f37f53751a65df4Felix Gabriel Mance ApplTerm (addParAppl t1) (addParAppl t2)
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldResolvedMixTerm = \ _ n tys ->
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder ResolvedMixTerm n tys . map addParAppl
83f5f3291f9b40fa688776b4da10b5fa102a5ff8Felix Gabriel Mance , foldTypedTerm = \ _ ->
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance TypedTerm . addParAppl
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , foldMixfixTerm = \ _ -> MixfixTerm . map addParAppl
fa544036407a8ec4be203ebd5e3bff225175e664Felix Gabriel Mance , foldAsPattern = \ _ v -> AsPattern v . addParAppl
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel ManceparenTerm :: Term -> Term
e26bfed39ffa184453272125a4adf147206eac74Christian MaederparenTerm = foldTerm parenTermRec
fa544036407a8ec4be203ebd5e3bff225175e664Felix Gabriel Mance-- | print an equation with different symbols between pattern and term
83f5f3291f9b40fa688776b4da10b5fa102a5ff8Felix Gabriel ManceprintEq0 :: Doc -> (Doc, Doc) -> Doc
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian MaederprintEq0 s (p, t) = sep [p, hsep [s, t]]
e26bfed39ffa184453272125a4adf147206eac74Christian MaederprintGenVarDecls :: [GenVarDecl] -> Doc
e26bfed39ffa184453272125a4adf147206eac74Christian MaederprintGenVarDecls = fsep . punctuate semi . map
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder ( \ l -> case l of
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder [x] -> pretty x
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder GenVarDecl (VarDecl _ t _ _) : _ -> sep
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder [ ppWithCommas (map ( \ (GenVarDecl (VarDecl v _ _ _)) -> v) l)
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder , printVarDeclType t]
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder GenTypeVarDecl (TypeArg _ e c _ _ _ _) : _ -> sep
e26bfed39ffa184453272125a4adf147206eac74Christian Maeder [ ppWithCommas (map ( \ (GenTypeVarDecl v) -> varOfTypeArg v) l)
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance , printVarKind e c]
4b7c9b9fec53befb553f2c9b11e30a4fe2235e03Felix Gabriel Mance _ -> error "printGenVarDecls") . groupBy sameType
4b7c9b9fec53befb553f2c9b11e30a4fe2235e03Felix Gabriel MancesameType :: GenVarDecl -> GenVarDecl -> Bool
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel MancesameType g1 g2 = case (g1, g2) of
863fa65ac095659c6da1cde7fe7b839f1e7f60f9Felix Gabriel Mance (GenVarDecl (VarDecl _ t1 Comma _), GenVarDecl (VarDecl _ t2 _ _))
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance | t1 == t2 -> True
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder (GenTypeVarDecl (TypeArg _ e1 c1 _ _ Comma _),
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance GenTypeVarDecl (TypeArg _ e2 c2 _ _ _ _)) | e1 == e2 && c1 == c2 -> True
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel ManceprintVarDeclType :: Type -> Doc
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel ManceprintVarDeclType t = case t of
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance MixfixType [] -> empty
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance _ -> colon <+> pretty t
1a38107941725211e7c3f051f7a8f5e12199f03acmaederinstance Pretty VarDecl where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty (VarDecl v t _ _) = pretty v <+> printVarDeclType t
1a38107941725211e7c3f051f7a8f5e12199f03acmaederinstance Pretty GenVarDecl where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty gvd = case gvd of
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance GenVarDecl v -> pretty v
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance GenTypeVarDecl tv -> pretty tv
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Manceinstance Pretty TypeArg where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty (TypeArg v e c _ _ _ _) =
669b3375925f7a145d287fa89f3a815708dbe7a1Christian Maeder pretty v <+> printVarKind e c
669b3375925f7a145d287fa89f3a815708dbe7a1Christian Maeder-- | don't print an empty list and put parens around longer lists
1a38107941725211e7c3f051f7a8f5e12199f03acmaederprintList0 :: (Pretty a) => [a] -> Doc
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel ManceprintList0 l = case l of
669b3375925f7a145d287fa89f3a815708dbe7a1Christian Maeder [x] -> pretty x
68de80eb2800338cbd16512106fcadab79325d8bChristian Maeder _ -> parens $ ppWithCommas l
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Manceinstance Pretty BasicSpec where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty (BasicSpec l) = if null l then specBraces empty else
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance changeGlobalAnnos addBuiltins . vcat $ map pretty l
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Manceinstance Pretty ProgEq where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty (ProgEq p t ps) = printEq0 equals $ foldEq printTermRec
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance $ ProgEq (rmSomeTypes p) (rmSomeTypes t) ps
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Manceinstance Pretty BasicItem where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty bi = case bi of
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance SigItems s -> pretty s
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance ProgItems l _ -> noNullPrint l $ sep [keyword programS, semiAnnoted l]
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance ClassItems i l _ -> noNullPrint l $ let
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance b = semiAnnos pretty l
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance Plain -> topSigKey (classS ++ if p then "es" else "") <+> b
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance Instance -> sep [keyword classS <+>
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance keyword (instanceS ++ if p then sS else ""), b]
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance GenVarItems l _ -> topSigKey (varS ++ pluralS l) <+> printGenVarDecls l
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance FreeDatatype l _ -> sep
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder [ keyword freeS <+> keyword (typeS ++ pluralS l)
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu , semiAnnos pretty l]
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder GenItems l _ -> let gkw = keyword generatedS in
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu (if all (isDatatype . item) l then \ i -> gkw <+> rmTopKey i
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder else \ i -> sep [gkw, specBraces i])
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder $ vcat $ map (printAnnoted pretty) l
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu AxiomItems vs fs _ -> sep
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu [ if null vs then empty else forallDoc <+> printGenVarDecls vs
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu _ -> let pp = addBullet . pretty in
6d907570443508c99867ea29ddf5e5cb0a2ef8c2Christian Maeder vcat $ map (printAnnoted pp) (init fs)
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu ++ [printSemiAnno pp True $ last fs]]
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu Internal l _ -> sep
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu [ keyword internalS
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai Codescu , specBraces $ vcat $ map (printAnnoted pretty) l]
e40758c36e3e5312669558ad189b24b3eaf10c59Mihai CodescuplClass :: [Annoted ClassItem] -> Bool
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceplClass l = case map item l of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance _ : _ : _ -> True
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance [ClassItem (ClassDecl (_ : _ : _) _ _) _ _] -> True
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederpluralS :: [a] -> String
1a38107941725211e7c3f051f7a8f5e12199f03acmaederpluralS l = case l of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance _ : _ : _ -> sS
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisDatatype :: SigItems -> Bool
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisDatatype si = case si of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder TypeItems _ l _ -> all
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder ((\ t -> case t of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder Datatype _ -> True
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder _ -> False) . item) l
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maederinstance Pretty OpBrand where
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder pretty = keyword . show
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maederinstance Pretty SigItems where
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder pretty si = case si of
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder TypeItems i l _ -> noNullPrint l $
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder let b = semiAnnos pretty l in case i of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder Plain -> topSigKey ((if all (isSimpleTypeItem . item) l
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder then typeS else typeS) ++ plTypes l) <+> b
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder sep [keyword typeS <+> keyword (instanceS ++ plTypes l), b]
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder OpItems b l _ -> noNullPrint l $ topSigKey (show b ++ plOps l)
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder <+> let po = prettyOpItem $ isPred b in
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder if case item $ last l of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder OpDecl _ _ a@(_ : _) _ -> case last a of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder UnitOpAttr {} -> True
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder OpDefn {} -> True
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder then vcat (map (printSemiAnno po True) l)
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder else semiAnnos po l
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederplTypes :: [Annoted TypeItem] -> String
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederplTypes l = case map item l of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder _ : _ : _ -> sS
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder [TypeDecl (_ : _ : _) _ _] -> sS
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder [SubtypeDecl (_ : _ : _) _ _] -> sS
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder [IsoDecl (_ : _ : _) _] -> sS
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederplOps :: [Annoted OpItem] -> String
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederplOps l = case map item l of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder _ : _ : _ -> sS
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder [OpDecl (_ : _ : _) _ _ _] -> sS
d66846429fcdd6882e62c7e5b911f98b3812ff09Felix Gabriel ManceisSimpleTypeItem :: TypeItem -> Bool
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisSimpleTypeItem ti = case ti of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder TypeDecl l k _ -> k == universe && all isSimpleTypePat l
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder SubtypeDecl l (TypeName i _ _) _ ->
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder not (isMixfix i) && all isSimpleTypePat l
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder SubtypeDefn p (Var _) t _ _ ->
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder isSimpleTypePat p && isSimpleType t
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisSimpleTypePat :: TypePattern -> Bool
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisSimpleTypePat tp = case tp of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder TypePattern i [] _ -> not $ isMixfix i
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisSimpleType :: Type -> Bool
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian MaederisSimpleType t = case t of
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder TypeName i _ _ -> not $ isMixfix i
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder TypeToken _ -> True
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder MixfixType[TypeToken _, BracketType Squares (_ : _) _] -> True
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maederinstance Pretty ClassItem where
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder pretty (ClassItem d l _) = pretty d $+$ noNullPrint l
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder (specBraces $ vcat $ map (printAnnoted pretty) l)
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maederinstance Pretty ClassDecl where
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder pretty (ClassDecl l k _) = let cs = ppWithCommas l in
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maeder if k == universe then cs else fsep [cs, less, pretty k]
b1162cc13e8371724e3382ae6d1cfdeb43891fbbChristian Maederinstance Pretty Vars where
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance pretty vd = case vd of
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance Var v -> pretty v
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance VarTuple vs _ -> parens $ ppWithCommas vs
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Manceinstance Pretty TypeItem where
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance pretty ti = case ti of
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance TypeDecl l k _ -> sep [ppWithCommas l, printKind k]
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance SubtypeDecl l t _ ->
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance fsep [ppWithCommas l, less, pretty t]
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance IsoDecl l _ -> fsep $ punctuate (space <> equals) $ map pretty l
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance SubtypeDefn p v t f _ ->
c704da29ad5d9d00c07e75f9109442d178dd990bFelix Gabriel Mance fsep [pretty p, equals,
a4a1b0cfce938fc38d5924b8fb6a7e140602ec5cFelix Gabriel Mance specBraces $ fsep
cbb0a924599bcaea230e7dcd2892cc91c49319aeChristian Maeder [pretty v, colon <+> pretty t, bullet <+> pretty f]]
52991d9b46a98ad6a9020421a3244950b0f8a522Felix Gabriel Mance AliasType p _ (TypeScheme l t _) _ ->
52991d9b46a98ad6a9020421a3244950b0f8a522Felix Gabriel Mance fsep $ pretty p : map (pretty . varOfTypeArg) l
52991d9b46a98ad6a9020421a3244950b0f8a522Felix Gabriel Mance ++ [text assignS <+> pretty t]
a4a1b0cfce938fc38d5924b8fb6a7e140602ec5cFelix Gabriel Mance Datatype t -> pretty t
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceprintItScheme :: [PolyId] -> Bool -> TypeScheme -> Doc
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceprintItScheme ps b = (case ps of
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance [p] -> printTypeScheme p
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance _ -> pretty) . (if b then unPredTypeScheme else id)
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceprintHead :: [[VarDecl]] -> [Doc]
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceprintHead = map ((<> space) . parens . printGenVarDecls . map GenVarDecl)
1a38107941725211e7c3f051f7a8f5e12199f03acmaederprettyOpItem :: Bool -> OpItem -> Doc
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel ManceprettyOpItem b oi = case oi of
707454ba169478cbf17b91b53f8f0aa2ff8a89beChristian Maeder OpDecl l t a _ -> fsep $ punctuate comma (map pretty l)
707454ba169478cbf17b91b53f8f0aa2ff8a89beChristian Maeder ++ [colon <+>
707454ba169478cbf17b91b53f8f0aa2ff8a89beChristian Maeder (if null a then id else (<> comma))(printItScheme l b t)]
707454ba169478cbf17b91b53f8f0aa2ff8a89beChristian Maeder ++ punctuate comma (map pretty a)
707454ba169478cbf17b91b53f8f0aa2ff8a89beChristian Maeder OpDefn n ps s t _ -> fcat $
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance (if null ps then (<> space) else id) (pretty n)
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance : printHead ps
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance ++ (if b then [] else [colon <+> printItScheme [n] b s <> space])
c77c0efe19dc6556ac872828bfb4cfc5fbca5ac5Felix Gabriel Mance ++ [(if b then equiv else equals) <> space, pretty t]
fa544036407a8ec4be203ebd5e3bff225175e664Felix Gabriel Manceinstance Pretty PolyId where
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance pretty (PolyId i@(Id ts cs ps) tys _) = if null tys then pretty i else
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance let (fts, plcs) = splitMixToken ts
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Mance in idDoc (Id fts cs ps) <> brackets (ppWithCommas tys)
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder <> hcat (map pretty plcs)
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Manceinstance Pretty BinOpAttr where
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance pretty a = text $ case a of
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance Assoc -> assocS
e99c3c1f572d0442872bba58f187ca520ef5d040Felix Gabriel Manceinstance Pretty OpAttr where
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance pretty oa = case oa of
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance BinOpAttr a _ -> pretty a
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance UnitOpAttr t _ -> text unitS <+> pretty t
ffa6044b04fa0e31242141ff56a5d80c4233b676Felix Gabriel Manceinstance Pretty DatatypeDecl where
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance pretty (DatatypeDecl p k alts d _) =
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance fsep [ pretty p, printKind k, defn
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder <+> cat (punctuate (space <> bar <> space)
c298a419605037f5352b5ad0f67b3e06db094051Felix Gabriel Mance $ map pretty alts)
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Mance _ -> keyword derivingS <+> ppWithCommas d]
8af00c8930672188ae80c8829428859160d329d0Felix Gabriel Manceinstance Pretty Alternative where
771c32080c77497c6c023a3b1c422f7daf3773f7Felix Gabriel Mance pretty alt = case alt of
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder Constructor n cs p _ -> pretty n <+> fsep