PrintAs.hs revision 48c4688439e0aade4faeebf25ca8b16d661e47af
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederModule : $Header$
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederCopyright : (c) Christian Maeder and Uni Bremen 2003
75a6279dbae159d018ef812185416cf6df386c10Till MossakowskiLicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederMaintainer : hets@tzi.de
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederStability : experimental
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederPortability : portable
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder printing data types of the abstract syntax
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport Common.GlobalAnnotations(GlobalAnnos)
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
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maederinstance PrettyPrint Variance where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ v = text $ show v
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maederinstance PrettyPrint Kind where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga knd = case knd of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Universe _ -> text "Type"
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder MissingKind -> space
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ClassKind ci _ -> printText0 ga ci
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Downset mt t _ _ ->
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder let tok = case mt of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Nothing -> text "_"
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Just x -> text (tokStr x) <+> text dotS <+> text (tokStr x)
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder in braces (tok <+>
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder text lessS <+> printText0 ga t)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Intersection ks _ -> printList0 ga ks
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FunKind k1 k2 _ ->
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder ExtKind (FunKind _ _ _) InVar _ -> parens
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder FunKind _ _ _ -> parens
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> id) (printText0 ga k1)
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder <+> text funS
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder <+> printText0 ga k2
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ExtKind k v _ -> (case v of
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> case k of
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder FunKind _ _ _ -> parens
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> id) (printText0 ga k) <> printText0 ga v
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint TypePattern where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga tp = case tp of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypePattern name args _ -> printText0 ga name
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <> fcat (map (parens . printText0 ga) args)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypePatternToken t -> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder MixfixTypePattern ts -> fsep (map (printText0 ga) ts)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BracketTypePattern k l _ -> bracket k $ commaT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypePatternArg t _ -> parens $ printText0 ga t
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | put proper brackets around a document
c4e912fc181d72c8d0e0e38d0351278182f0d0b5Christian Maederbracket :: BracketKind -> Doc -> Doc
469af98c69977faf5666e689eae863c1606ce269Christian Maederbracket b t = let (o,c) = getBrackets b in ptext o <> t <> ptext c
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | print a 'Kind' plus a preceding colon (or nothing for 'star')
024621f43239cfe9629e35d35a8669fad7acbba2Christian MaederprintKind :: GlobalAnnos -> Kind -> Doc
024621f43239cfe9629e35d35a8669fad7acbba2Christian MaederprintKind ga kind = case kind of
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder Universe _ -> empty
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder Downset Nothing t _ _ ->
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder space <> text lessS <+> printText0 ga t
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> space <> colon <+> printText0 ga kind
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Type where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga ty = case ty of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeName name _k _i -> printText0 ga name
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeAppl t1 t2 -> case t1 of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeName (Id [a, Token "__" _, b] [] []) _ _ ->
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga a <> printText0 ga t2 <> printText0 ga b
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeAppl (TypeName (Id [Token "__" _, inTok, Token "__" _]
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder [] []) _ _) t0 -> printText0 ga t0
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> printText0 ga inTok <+> printText0 ga t2
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> (case t1 of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeName _ _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeToken _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BracketType _ _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeAppl _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> parens) (printText0 ga t1) <+>
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeName _ _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeToken _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BracketType _ _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> parens) (printText0 ga t2)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeToken t -> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BracketType k l _ -> bracket k $ commaT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder KindedType t kind _ -> (case t of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FunType _ _ _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ProductType [] _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ProductType _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder LazyType _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeAppl _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> id) (printText0 ga t)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> colon <+> printText0 ga kind
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder MixfixType ts -> fsep (map (printText0 ga) ts)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder LazyType t _ -> text quMark <+> (case t of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FunType _ _ _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ProductType [] _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ProductType _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder KindedType _ _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> id) (printText0 ga t)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ProductType ts _ -> if null ts then ptext "Unit"
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder -- parens empty
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder else fsep (punctuate (space <> char '*')
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder (map ( \ t ->
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder FunType _ _ _ _ -> parens
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder ProductType [] _ -> id
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder ProductType _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder _ -> id) $ printText0 ga t) ts))
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FunType t1 arr t2 _ -> (case t1 of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FunType _ _ _ _ -> parens
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> id) (printText0 ga t1)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> printText0 ga arr
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> printText0 ga t2
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maederinstance PrettyPrint Pred where
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder printText0 ga (IsIn c ts) = if null ts then printText0 ga c
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder else if null $ tail ts then
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder printText0 ga (head ts) <+>
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder colon <+> printText0 ga c
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder else printText0 ga c <+>
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder fsep (punctuate space
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder (map (printText0 ga) ts))
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maederinstance PrettyPrint t => PrettyPrint (Qual t) where
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder printText0 ga (ps :=> t) = (if null ps then empty
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder else parens $ commaT_text ga ps <+>
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder ptext implS <+> space) <>
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder-- no curried notation for bound variables
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint TypeScheme where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga (TypeScheme vs t _) = let tdoc = printText0 ga t in
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder if null vs then tdoc else
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder hang (text forallS <+> semiT_text ga vs <+> text dotS) 2 tdoc
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maederinstance PrettyPrint Instance where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ i = case i of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Instance -> space <> text instanceS
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Plain -> empty
fe883661c9d1a5a8b42ac4e8673ec133d9dad354Christian Maederinstance PrettyPrint Partiality where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ p = case p of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Partial -> text quMark
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Total -> empty
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Arrow where
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ a = text $ show a
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Quantifier where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ q = text $ show q
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint TypeQual where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ q = text $ show q
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Term where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga t = printTerm ga
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder QualVar _ _ _ -> True
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder QualOp _ _ _ _ -> True
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> False) t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederunPredType :: Type -> Type
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederunPredType t = case t of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FunType ty PFunArr (ProductType [] _) _ -> ty
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederunPredTypeScheme :: TypeScheme -> TypeScheme
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederunPredTypeScheme = mapTypeOfScheme unPredType
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederprintTerm :: GlobalAnnos -> Bool -> Term -> Doc
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederprintTerm ga b trm =
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder let ppParen = if b then parens else id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder commaT = fsep . punctuate comma . map (printTerm ga False)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TupleTerm _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BracketTerm _ _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TermToken _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder MixTypeTerm _ _ _ -> id
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> ppParen)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder $ case trm of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder QualVar v t _ -> sep [text varS <+> printText0 ga v,
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder colon <+> printText0 ga t]
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder QualOp br n t _ -> sep [printText0 ga br <+> printText0 ga n,
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder colon <+> printText0 ga
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder (if isPred br then unPredTypeScheme t else t)]
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ResolvedMixTerm n ts _ ->
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder [] -> printText0 ga n
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder [t] -> printText0 ga n <> printTerm ga True t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder _ -> printText0 ga n <>
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder parens (commaT ts)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ApplTerm t1 t2 _ -> cat [printText0 ga t1, nest 2
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder $ printTerm ga True t2]
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TupleTerm ts _ -> parens (commaT ts)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypedTerm term q typ _ -> hang (printText0 ga term
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> printText0 ga q)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder 4 $ printText0 ga typ
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder QuantifiedTerm q vs t _ -> printText0 ga q
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga vs
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> text dotS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder LambdaTerm ps q t _ -> hang (text lamS
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder <+> (case ps of
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder [p] -> printText0 ga p
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder _ -> fcat $ map
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder (parens . printTerm ga False) ps)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> (case q of
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder Partial -> text dotS
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Total -> text $ dotS ++ exMark))
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder 2 $ printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder CaseTerm t es _ -> hang (text caseS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> text ofS)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder 4 $ vcat (punctuate (text " | ")
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (map (printEq0 ga funS) es))
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder LetTerm br es t _ ->
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder let dt = printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder des = vcat $ punctuate semi $
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder map (printEq0 ga equalS) es
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder in case br of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Let -> sep [text letS <+> des, text inS <+> dt]
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Where -> hang (sep [dt, text whereS]) 6 des
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TermToken t -> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder MixTypeTerm q t _ -> printText0 ga q <+> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder MixfixTerm ts -> fsep $ map (printText0 ga) ts
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BracketTerm k l _ -> bracket k $ commaT l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder AsPattern v p _ -> printText0 ga v
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga p
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | print an equation with different symbols between 'Pattern' and 'Term'
c4e912fc181d72c8d0e0e38d0351278182f0d0b5Christian MaederprintEq0 :: GlobalAnnos -> String -> ProgEq -> Doc
48c4688439e0aade4faeebf25ca8b16d661e47afChristian MaederprintEq0 ga s (ProgEq p t _) = hang (hang (printText0 ga p) 2 $ text s)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder 4 $ printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint VarDecl where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (VarDecl v t _ _) = printText0 ga v <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint GenVarDecl where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga gvd = case gvd of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder GenVarDecl v -> printText0 ga v
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder GenTypeVarDecl tv -> printText0 ga tv
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint TypeArg where
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder printText0 ga (TypeArg v c _ _) = printText0 ga v <+> colon
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder <+> printText0 ga c
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | don't print an empty list and put parens around longer lists
da245da15da78363c896e44ea97a14ab1f83eb50Christian MaederprintList0 :: (PrettyPrint a) => GlobalAnnos -> [a] -> Doc
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederprintList0 ga l = case l of
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder [x] -> printText0 ga x
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder _ -> parens $ commaT_text ga l
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maederinstance PrettyPrint InstOpId where
49a475aee8bae6c05798d65fddf13ec6da66f0beChristian Maeder printText0 ga (InstOpId n l _) = printText0 ga n
49a475aee8bae6c05798d65fddf13ec6da66f0beChristian Maeder <> noPrint (null l)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder (brackets $ semiT_text ga l)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder------------------------------------------------------------------------
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder------------------------------------------------------------------------
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | print a 'TypeScheme' as a pseudo type
51281dddda866c0cda9fca22bf6bc4eea7128112Christian MaederprintPseudoType :: GlobalAnnos -> TypeScheme -> Doc
51281dddda866c0cda9fca22bf6bc4eea7128112Christian MaederprintPseudoType ga (TypeScheme l t _) = noPrint (null l) (text lamS
715a002611e0c503c11cc3aa80835763215e689dChristian Maeder <+> (if null $ tail l then
715a002611e0c503c11cc3aa80835763215e689dChristian Maeder printText0 ga $ head l
715a002611e0c503c11cc3aa80835763215e689dChristian Maeder else fcat(map (parens . printText0 ga) l))
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder <+> text dotS <> space) <> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint BasicSpec where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (BasicSpec l) = vcat (map (printText0 ga) l)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint ProgEq where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga = printEq0 ga equalS
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint BasicItem where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga bi = case bi of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder SigItems s -> printText0 ga s
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ProgItems l _ -> text programS <+> semiT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder ClassItems i l _ -> text classS <> printText0 ga i <+> semiT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder GenVarItems l _ -> text varS <+> semiT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder FreeDatatype l _ -> text freeS <+> text typeS
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder GenItems l _ -> text generatedS <+> braces (semiT_text ga l)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder AxiomItems vs fs _ -> (if null vs then empty
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder else text forallS <+> semiT_text ga vs)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (\x -> text dotS <+> printText0 ga x)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Internal l _ -> text internalS <+> braces (semiT_text ga l)
76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maederinstance PrettyPrint OpBrand where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ b = text $ show b
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint SigItems where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga si = case si of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeItems i l _ -> text typeS <> printText0 ga i <+> semiT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder OpItems b l _ -> printText0 ga b <+> semiT_text ga
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder (if isPred b then concat $
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder mapAnM ((:[]) . mapOpItem) l else l)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint ClassItem where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (ClassItem d l _) = printText0 ga d $$
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder if null l then empty
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder else braces (semiT_text ga l)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint ClassDecl where
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (ClassDecl l k _) = commaT_text ga l
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder <+> text lessS <+> printText0 ga k
37e2067019ef1e30bc7ad98b9bc623aa41cfa980Christian Maederinstance PrettyPrint Vars where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga vd = case vd of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Var v -> printText0 ga v
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder VarTuple vs _ -> parens $ commaT_text ga vs
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint TypeItem where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga ti = case ti of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder TypeDecl l k _ -> commaT_text ga l <>
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder printKind ga k
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder SubtypeDecl l t _ -> commaT_text ga l <+> text lessS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder IsoDecl l _ -> cat(punctuate (text " = ")
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (map (printText0 ga) l))
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder SubtypeDefn p v t f _ -> printText0 ga p
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text equalS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> braces (printText0 ga v
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text dotS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga f)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder AliasType p k t _ -> (printText0 ga p <>
715a002611e0c503c11cc3aa80835763215e689dChristian Maeder Nothing -> empty
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder Just j -> space <> colon <+>
24c4e80d78a5810e2713076736a23728f9f99235Christian Maeder printText0 ga j)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text assignS
51281dddda866c0cda9fca22bf6bc4eea7128112Christian Maeder <+> printPseudoType ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Datatype t -> printText0 ga 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
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint OpItem where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga oi = case oi of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder OpDecl l t as _ -> commaT_text ga l <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> (printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <> (if null as then empty
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder else comma <> space)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <> commaT_text ga as)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder OpDefn n ps s p t _ ->
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga n <> fcat (map (parens . semiT_text ga) ps)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> colon <> printText0 ga p
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga s
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text equalS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint BinOpAttr where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 _ a = text $ case a of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Assoc -> assocS
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Comm -> commS
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Idem -> idemS
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint OpAttr where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga oa = case oa of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder BinOpAttr a _ -> printText0 ga a
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder UnitOpAttr t _ -> text unitS <+> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint DatatypeDecl where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (DatatypeDecl p k as d _) = (printText0 ga p <>
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder printKind ga k)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text defnS
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> vcat(punctuate (text " | ")
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (map (printText0 ga) as))
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder <+> case d of [] -> empty
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> text derivingS
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder <+> commaT_text ga d
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint Alternative where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga alt = case alt of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Constructor n cs p _ ->
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga n <+> fsep (map (parens . semiT_text ga) cs)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <> printText0 ga p
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Subtype l _ -> text typeS <+> commaT_text ga l
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maederinstance PrettyPrint Component where
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder printText0 ga sel = case sel of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Selector n p t _ _ -> printText0 ga n
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> colon <> printText0 ga p
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder <+> printText0 ga t
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder NoSelector t -> printText0 ga t
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maederinstance PrettyPrint OpId where
49a475aee8bae6c05798d65fddf13ec6da66f0beChristian Maeder printText0 ga (OpId n ts _) = printText0 ga n
49a475aee8bae6c05798d65fddf13ec6da66f0beChristian Maeder <+> noPrint (null ts)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder (brackets $ commaT_text ga ts)