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