PrintAs.hs revision 37354e3ed68875fb527338105a610df481f98cb0
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederModule : $Header$
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederCopyright : (c) Christian Maeder and Uni Bremen 2003
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiMaintainer : maeder@tzi.de
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederStability : experimental
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maederprinting data types of the abstract syntax
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maeder-- | short cut for: if b then empty else d
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian MaedernoPrint :: Bool -> Doc -> Doc
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian MaedernoPrint b d = if b then empty else d
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaedernoNullPrint :: [a] -> Doc -> Doc
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaedernoNullPrint = noPrint . null
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedercommaDs :: Pretty a => [a] -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedercommaDs = fsep . punctuate comma . map pretty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedersemiDs :: Pretty a => [a] -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedersemiDs = fsep . punctuate semi . map pretty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedersemiAnnoted :: Pretty a => [Annoted a] -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedersemiAnnoted = semiAnnos pretty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Variance where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty = idDoc . simpleIdToId . mkSimpleId . show
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty a => Pretty (AnyKind a) where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty knd = case knd of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ClassKind ci -> pretty ci
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder FunKind v k1 k2 _ -> pretty v <>
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder FunKind _ _ _ _ -> parens
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> id) (pretty k1)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> pretty k2
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty TypePattern where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty tp = case tp of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypePattern name args _ -> pretty name
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <> fcat (map (parens . pretty) args)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypePatternToken t -> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder MixfixTypePattern ts -> fsep (map (pretty) ts)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder BracketTypePattern k l _ -> bracket k $ commaDs l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypePatternArg t _ -> parens $ pretty t
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | put proper brackets around a document
c4e912fc181d72c8d0e0e38d0351278182f0d0b5Christian Maederbracket :: BracketKind -> Doc -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederbracket b = case b of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Parens -> parens
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Squares -> brackets
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Braces -> specBraces
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder NoBrackets -> id
92aa1b88f02d2a413da60dba78acd34312e6f29aChristian Maeder-- | print a 'Kind' plus a preceding colon (or nothing)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintKind :: Kind -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintKind k = if k == universe then empty else
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder printVarKind InVar (VarKind k)
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder-- | print the kind of a variable with its variance and a preceding colon
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintVarKind :: Variance -> VarKind -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintVarKind e vk = case vk of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder space <> less <+> pretty t
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder VarKind k -> space <> colon <+>
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty e <> pretty k
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder MissingKind -> empty
d48085f765fca838c1d972d2123601997174583dChristian Maederdata TypePrec = Outfix | Prefix | ProdInfix | FunInfix deriving (Eq, Ord)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian MaederparenPrec :: TypePrec -> (TypePrec, Doc) -> Doc
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian MaederparenPrec p1 (p2, d) = if p2 < p1 then d else parens d
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian MaedertoMixType :: Type -> (TypePrec, Doc)
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaedertoMixType typ = case typ of
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder ExpandedType t1 _ -> toMixType t1
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder {- (Prefix, ExpandedType
d48085f765fca838c1d972d2123601997174583dChristian Maeder (parenPrec Prefix $ toMixType t1)
2986838ec286d67e7c199e7ea81e7364ca36ad25Christian Maeder $ parenPrec Prefix $ toMixType t2) -}
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder BracketType k l _ -> (Outfix, bracket k $ fsep $ punctuate comma $ map
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder (snd . toMixType) l)
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder KindedType t kind _ -> (Prefix,
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder fsep [parenPrec Prefix $ toMixType t, colon, pretty kind])
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder MixfixType ts -> (Prefix, fsep $ map (snd . toMixType) ts)
d48085f765fca838c1d972d2123601997174583dChristian Maeder _ -> let (topTy, tyArgs) = getTypeAppl typ in
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder case topTy of
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder TypeName name@(Id ts cs _) _k _i -> let topDoc = pretty name in
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder case tyArgs of
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder [] -> (Outfix, pretty name)
d48085f765fca838c1d972d2123601997174583dChristian Maeder [arg] -> let dArg = toMixType arg in
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder [e1, e2, e3] | not (isPlace e1) && isPlace e2
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder && not (isPlace e3) && null cs ->
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder (Outfix, fsep [pretty e1, snd dArg, pretty e3])
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder _ -> (Prefix, fsep [topDoc, parenPrec Prefix dArg])
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder [arg1, arg2] -> let dArg1 = toMixType arg1
d48085f765fca838c1d972d2123601997174583dChristian Maeder dArg2 = toMixType arg2 in
d48085f765fca838c1d972d2123601997174583dChristian Maeder [e1, e2, e3] | isPlace e1 && not (isPlace e2)
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder && isPlace e3 && null cs ->
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder if tokStr e2 == prodS then
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder (ProdInfix, fsep [
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder parenPrec ProdInfix dArg1, cross,
d48085f765fca838c1d972d2123601997174583dChristian Maeder parenPrec ProdInfix dArg2])
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder else -- assume fun type
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder (FunInfix, fsep [
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder parenPrec FunInfix dArg1, pretty e2, snd dArg2])
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder _ -> (Prefix, fsep [topDoc, parenPrec Prefix dArg1,
d48085f765fca838c1d972d2123601997174583dChristian Maeder parenPrec Prefix dArg2])
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder _ -> if name == productId (length tyArgs) then
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder (ProdInfix, fsep $ punctuate (space <> cross) $
d48085f765fca838c1d972d2123601997174583dChristian Maeder map (parenPrec ProdInfix . toMixType) tyArgs)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder else (Prefix, fsep $ topDoc :
d48085f765fca838c1d972d2123601997174583dChristian Maeder map (parenPrec Prefix . toMixType) tyArgs)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder _ | null tyArgs -> (Outfix, printType topTy)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder _ -> (Prefix, fsep $ parenPrec ProdInfix (toMixType topTy)
d48085f765fca838c1d972d2123601997174583dChristian Maeder : map (parenPrec Prefix . toMixType) tyArgs)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintType :: Type -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintType ty = case ty of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypeName name _ _ -> pretty name
2986838ec286d67e7c199e7ea81e7364ca36ad25Christian Maeder -- if i == 0 then empty else text ("_v"++ show i)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder TypeAppl t1 t2 -> fcat [parens (printType t1),
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder parens (printType t2)]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ExpandedType t1 t2 -> printType t1 <> text asP <> printType t2
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypeToken t -> pretty t
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder BracketType k l _ -> bracket k $ fsep $
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder punctuate comma $ map (printType) l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder KindedType t kind _ -> printType t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> colon <+> pretty kind
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder MixfixType ts -> fsep $ map printType ts
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Type where
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder pretty = snd . toMixType
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder-- no curried notation for bound variables
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty TypeScheme where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (TypeScheme vs t _) = let tdoc = pretty t in
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder if null vs then tdoc else
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep [forallDoc, semiDs vs, bullet, tdoc]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Instance where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty i = case i of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Instance -> space <> keyword instanceS
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Plain -> empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Partiality where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty p = case p of
37354e3ed68875fb527338105a610df481f98cb0Christian Maeder Partial -> quMarkD
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Total -> empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Quantifier where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty q = case q of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Universal -> forallDoc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Existential -> exists
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Unique -> unique
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty TypeQual where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty q = case q of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder OfType -> colon
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder AsType -> text asS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder InType -> inDoc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Inferred -> colon
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Term where
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder pretty = changeGlobalAnnos addBuiltins . printTerm . rmSomeTypes
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederisSimpleTerm :: Term -> Bool
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederisSimpleTerm trm = case trm of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder QualVar _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder QualOp _ _ _ _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ResolvedMixTerm _ _ _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ApplTerm _ _ _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TupleTerm _ _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TermToken _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder BracketTerm _ _ _ -> True
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederparenTermDoc :: Term -> Doc -> Doc
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian MaederparenTermDoc trm = if isSimpleTerm trm then id else parens
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintTermRec :: FoldRec Doc (Doc, Doc)
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian MaederprintTermRec = let commaT = fsep . punctuate comma in FoldRec
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder { foldQualVar = \ _ vd -> parens $ keyword varS <+> pretty vd
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder , foldQualOp = \ _ br n t _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder parens $ fsep [pretty br, pretty n, colon, pretty $
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder if isPred br then unPredTypeScheme t else t]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldResolvedMixTerm = \ (ResolvedMixTerm _ os _) n ts _ ->
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder if placeCount n == length ts || null ts then
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder idApplDoc n $ zipWith parenTermDoc os ts
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder else idApplDoc applId [idDoc n, parens $ commaT ts]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldApplTerm = \ (ApplTerm o1 o2 _) t1 t2 _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder case (o1, o2) of
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder (ResolvedMixTerm n [] _, TupleTerm ts _)
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder | placeCount n == length ts ->
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder idApplDoc n $ zipWith parenTermDoc ts $ map printTerm ts
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder (ResolvedMixTerm n [] _, _) | placeCount n == 1 ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder idApplDoc n [parenTermDoc o2 t2]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> idApplDoc applId [parenTermDoc o1 t1, parenTermDoc o2 t2]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldTupleTerm = \ _ ts _ -> parens $ commaT ts
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldTypedTerm = \ _ t q typ _ -> fsep [t, pretty q, pretty typ]
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder , foldQuantifiedTerm = \ _ q vs t _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep [pretty q, semiDs vs, bullet, t]
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder , foldLambdaTerm = \ _ ps q t _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep [ lambda
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> fcat $ map parens ps
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Partial -> bullet
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Total -> bullet <> text exMark
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder , foldCaseTerm = \ _ t es _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep [text caseS, t, text ofS,
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder vcat $ punctuate (space <> bar <> space) $
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder map (printEq0 funArrow) es]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldLetTerm = \ _ br es t _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder let des = vcat $ punctuate semi $ map (printEq0 equals) es
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder in case br of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Let -> fsep [sep [text letS <+> des, text inS], t]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Where -> fsep [sep [t, text whereS], des]
966e627a1c06b302a06d59d08b8ab45905f3509cChristian Maeder Program -> text programS <+> des
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldTermToken = \ _ t -> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldMixTypeTerm = \ _ q t _ -> pretty q <+> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldMixfixTerm = \ _ ts -> fsep ts
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldBracketTerm = \ _ k l _ -> bracket k $ commaT l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldAsPattern = \ _ (VarDecl v _ _ _) p _ -> pretty v <+> text asP <+> p
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldProgEq = \ _ p t _ -> (p, t)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintTerm :: Term -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintTerm = foldTerm printTermRec
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederrmTypeRec :: MapRec
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederrmTypeRec = mapRec
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder { -- foldQualVar = \ _ (VarDecl v _ _ ps) -> ResolvedMixTerm v [] ps
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder foldQualOp = \ t _ (InstOpId i _ _) _ ps ->
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder if elem i $ map fst bList then
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder ResolvedMixTerm i [] ps else t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldTypedTerm = \ _ nt q ty ps ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Inferred -> nt
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> case nt of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypedTerm _ oq oty _ | oty == ty || oq == InType -> nt
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder QualVar (VarDecl _ oty _ _) | oty == ty -> nt
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> TypedTerm nt q ty ps
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederrmSomeTypes :: Term -> Term
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederrmSomeTypes = foldTerm rmTypeRec
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | print an equation with different symbols between 'Pattern' and 'Term'
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintEq0 :: Doc -> (Doc, Doc) -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintEq0 s (p, t) = fsep [p, s, t]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty VarDecl where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (VarDecl v t _ _) = pretty v <>
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder MixfixType [] -> empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> space <> colon <+> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty GenVarDecl where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty gvd = case gvd of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder GenVarDecl v -> pretty v
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder GenTypeVarDecl tv -> pretty tv
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty TypeArg where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (TypeArg v e c _ _ _ _) =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty v <> printVarKind e c
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | don't print an empty list and put parens around longer lists
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintList0 :: (Pretty a) => [a] -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintList0 l = case l of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder [x] -> pretty x
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> parens $ commaDs l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty InstOpId where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (InstOpId n l _) = pretty n <> noNullPrint l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (brackets $ semiDs l)
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | print a 'TypeScheme' as a pseudo type
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintPseudoType :: TypeScheme -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprintPseudoType (TypeScheme l t _) = noNullPrint l (lambda
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> (if null $ tail l then pretty $ head l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder else fcat(map (parens . pretty) l))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> bullet <> space) <> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty BasicSpec where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (BasicSpec l) = vcat (map (pretty) l)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty ProgEq where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty = printEq0 equals . foldEq printTermRec
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty BasicItem where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty bi = case bi of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder SigItems s -> pretty s
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ProgItems l _ -> noNullPrint l $ keyword programS <+> semiAnnoted l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ClassItems i l _ -> noNullPrint l $ topKey classS <> pretty i
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> semiAnnoted l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder GenVarItems l _ -> noNullPrint l $ topKey varS <+> semiDs l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder FreeDatatype l _ -> noNullPrint l $ keyword freeS <+> keyword typeS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> semiAnnoted l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder GenItems l _ -> noNullPrint l $ keyword generatedS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> specBraces (semiAnnoted l)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder AxiomItems vs fs _ ->
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder vcat $ (if null vs then [] else
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder [forallDoc <+> semiDs vs])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ++ (map ( \ x -> bullet <+> pretty x) fs)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Internal l _ -> noNullPrint l $ keyword internalS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> specBraces (semiAnnoted l)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty OpBrand where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty b = keyword $ show b
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty SigItems where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty si = case si of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypeItems i l _ -> noNullPrint l $ topKey typeS <> pretty i
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> semiAnnoted l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder OpItems b l _ -> noNullPrint l $ topKey (show b) <+> semiAnnoted
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder (if isPred b then concat $
2dfc7b04f2db681992ca04175f2beb0f127c9844Christian Maeder mapAnM ((:[]) . mapOpItem) l else l)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty ClassItem where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (ClassItem d l _) = pretty d $+$
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder if null l then empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder else specBraces (semiAnnoted l)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty ClassDecl where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (ClassDecl l k _) = fsep [commaDs l, less, pretty k]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Vars where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty vd = case vd of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Var v -> pretty v
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder VarTuple vs _ -> parens $ commaDs vs
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty TypeItem where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty ti = case ti of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder TypeDecl l k _ -> if null l then error "pretty TypeDecl" else
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder commaDs l <> printKind k
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder SubtypeDecl l t _ -> if null l then error "pretty SubtypeDecl"
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder else fsep [commaDs l, less, pretty t]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder IsoDecl l _ -> fsep $ punctuate (space <> equals) $ map pretty l
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder SubtypeDefn p v t f _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep [pretty p, equals,
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder specBraces $ fsep
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder [pretty v, colon, pretty t, bullet, pretty f]]
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder AliasType p k t _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep $ pretty p : (case k of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Nothing -> []
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Just j -> [colon, pretty j])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder ++ [text assignS, printPseudoType t]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Datatype t -> pretty t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaedermapOpItem :: OpItem -> OpItem
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaedermapOpItem oi = case oi of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder OpDecl l t as ps -> OpDecl l (unPredTypeScheme t) as ps
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder OpDefn n ps s p t qs -> OpDefn n ps (unPredTypeScheme s) p t qs
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty OpItem where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty oi = case oi of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder OpDecl l t attrs _ -> if null l then error "pretty OpDecl" else
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder commaDs l <+> colon <+> (pretty t
9c5b1136299d9052e4e995614a3a36a051a2682fChristian Maeder <> (if null attrs then empty else comma <> space)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <> commaDs attrs)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder OpDefn n ps s p t _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fsep [fcat $ pretty n : (map (parens . semiDs) ps)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , colon <> pretty p, pretty s, equals, pretty t]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty BinOpAttr where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty a = text $ case a of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Assoc -> assocS
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Comm -> commS
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Idem -> idemS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty OpAttr where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty oa = case oa of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder BinOpAttr a _ -> pretty a
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder UnitOpAttr t _ -> text unitS <+> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty DatatypeDecl where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (DatatypeDecl p k alts d _) = (pretty p <> printKind k)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> vcat(punctuate (space <> bar <> space)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder $ map pretty alts)
2dfc7b04f2db681992ca04175f2beb0f127c9844Christian Maeder <+> case d of [] -> empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> keyword derivingS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> commaDs d
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Alternative where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty alt = case alt of
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Constructor n cs p _ ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty n <+> fsep (map (parens . semiDs) cs)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Subtype l _ -> noNullPrint l $ text typeS <+> commaDs l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Component where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty sel = case sel of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Selector n p t _ _ -> pretty n
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <+> colon <> pretty p
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder NoSelector t -> pretty t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty OpId where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (OpId n ts _) = pretty n
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder <+> noNullPrint ts
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (brackets $ commaDs ts)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty Symb where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (Symb i mt _) =
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder pretty i <> (case mt of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Nothing -> empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Just (SymbType t) ->
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder empty <+> colon <+> pretty t)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty SymbItems where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (SymbItems k syms _ _) =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder printSK k <> commaDs syms
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty SymbOrMap where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (SymbOrMap s mt _) =
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder pretty s <> (case mt of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Nothing -> empty
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder empty <+> mapsto <+> pretty t)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance Pretty SymbMapItems where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (SymbMapItems k syms _ _) =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder printSK k <> commaDs syms
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder-- | print symbol kind
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian MaederprintSK :: SymbKind -> Doc
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder case k of Implicit -> empty
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder _ -> text (drop 3 $ show k) <> space