PrintAs.hs revision c18e9c3c6d5039618f1f2c05526ece84c7794ea3
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder{- |
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 Maeder
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederMaintainer : hets@tzi.de
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederStability : experimental
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederPortability : portable
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder printing data types of the abstract syntax
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder-}
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maedermodule HasCASL.PrintAs where
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport HasCASL.As
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport Common.Keywords
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport HasCASL.HToken
da245da15da78363c896e44ea97a14ab1f83eb50Christian Maederimport Common.Lib.Pretty
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maederimport Common.Id
da245da15da78363c896e44ea97a14ab1f83eb50Christian Maederimport Common.PPUtils
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport Common.PrettyPrint
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport Common.GlobalAnnotations(GlobalAnnos)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
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
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maeder
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maederinstance PrettyPrint Variance where
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ CoVar = text plusS
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ ContraVar = text minusS
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ InVar = empty
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maederinstance PrettyPrint Kind where
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ (Universe _) = text "Type"
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ MissingKind = space
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (ClassKind ci _) = printText0 ga ci
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (Downset mt t _ _) =
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder let tok = case mt of
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder Nothing -> text "_"
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder Just x -> text (tokStr x) <+> text dotS <+> text (tokStr x)
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder in braces (tok <+>
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder text lessS <+> printText0 ga t)
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (Intersection ks _) = printList0 ga ks
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (FunKind k1 k2 _) =
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder (case k1 of
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
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (ExtKind k v _) =
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder (case v of
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder InVar -> id
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> case k of
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder FunKind _ _ _ -> parens
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder _ -> id) (printText0 ga k) <> printText0 ga v
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint TypePattern where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TypePattern name args _) = printText0 ga name
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <> fcat (map (parens . printText0 ga) args)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TypePatternToken t) = printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (MixfixTypePattern ts) = fsep (map (printText0 ga) ts)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (BracketTypePattern k l _) = bracket k $ commaT_text ga l
49a475aee8bae6c05798d65fddf13ec6da66f0beChristian Maeder printText0 ga (TypePatternArg t _) = parens $ printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
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
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
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
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Type where
cde8e3d436089010ac1218ae57b8215203116a49Christian Maeder printText0 ga (TypeName name _k _i) = printText0 ga name
a64a0692ffff29e0846ca325b1811266a9f105e0Christian Maeder printText0 ga (TypeAppl t1 t2) = parens (printText0 ga t1)
a64a0692ffff29e0846ca325b1811266a9f105e0Christian Maeder <> parens (printText0 ga t2)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TypeToken t) = printText0 ga t
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (BracketType k l _) = bracket k $ commaT_text ga l
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder printText0 ga (KindedType t kind _) = (case t of
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder FunType _ _ _ _ -> parens
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder ProductType [] _ -> id
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder ProductType _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder LazyType _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder TypeAppl _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder _ -> id) (printText0 ga t)
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder <+> colon <+> printText0 ga kind
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (MixfixType ts) = fsep (map (printText0 ga) ts)
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder printText0 ga (LazyType t _) = text quMark <+> (case t of
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder FunType _ _ _ _ -> parens
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder ProductType [] _ -> id
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder ProductType _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder KindedType _ _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder _ -> id) (printText0 ga t)
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder printText0 ga (ProductType ts _) = if null ts then ptext "Unit"
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder -- parens empty
79a3b1a7bf306fdedbeb39f9908d62405f37f385Christian Maeder else fsep (punctuate (space <> text timesS)
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder (map ( \ t ->
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder (case t of
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder FunType _ _ _ _ -> parens
02535bb32f01cbb935f41f8ccb957ebb5c1091c6Christian Maeder ProductType [] _ -> id
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder ProductType _ _ -> parens
31242f7541fd6ef179e4eb5be7522ddf54ae397bChristian Maeder _ -> id) $ printText0 ga t) ts))
b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder printText0 ga (FunType t1 arr t2 _) = (case t1 of
b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder FunType _ _ _ _ -> parens
b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder _ -> id) (printText0 ga t1)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga arr
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t2
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
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 Maeder
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
a05bca7a10260c19581dff325389de3f8edefa5eChristian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder-- no curried notation for bound variables
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint TypeScheme where
49a475aee8bae6c05798d65fddf13ec6da66f0beChristian Maeder printText0 ga (TypeScheme vs t _) = noPrint (null vs) (text forallS
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga vs
51281dddda866c0cda9fca22bf6bc4eea7128112Christian Maeder <+> text dotS <+> space)
51281dddda866c0cda9fca22bf6bc4eea7128112Christian Maeder <> printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
fe883661c9d1a5a8b42ac4e8673ec133d9dad354Christian Maederinstance PrettyPrint Partiality where
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Partial = text quMark
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Total = text exMark
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Arrow where
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 _ a = text $ show a
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Quantifier where
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Universal = text forallS
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Existential = text existsS
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Unique = text $ existsS ++ exMark
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint TypeQual where
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ OfType = colon
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ AsType = text asS
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ InType = text inS
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Term where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (QualVar v t _) = parens $ text varS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga v
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (QualOp n t _) = parens $
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder text opS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga n
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder printText0 ga (ResolvedMixTerm n ts _) = (if isSimpleId n then
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder id else parens) (printText0 ga n)
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder <> noPrint (null ts) (parens $ commaT_text ga ts)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (ApplTerm t1 t2 _) = printText0 ga t1
323a93847c763e3755391f953aa79985aed3417eChristian Maeder <+> (case t2 of
323a93847c763e3755391f953aa79985aed3417eChristian Maeder QualVar _ _ _ -> id
323a93847c763e3755391f953aa79985aed3417eChristian Maeder QualOp _ _ _ -> id
323a93847c763e3755391f953aa79985aed3417eChristian Maeder TupleTerm _ _ -> id
323a93847c763e3755391f953aa79985aed3417eChristian Maeder BracketTerm Parens _ _ -> id
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder ResolvedMixTerm _ [] _ -> id
323a93847c763e3755391f953aa79985aed3417eChristian Maeder TermToken _ -> id
323a93847c763e3755391f953aa79985aed3417eChristian Maeder _ -> parens) (printText0 ga t2)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (TupleTerm ts _) = parens $ commaT_text ga ts
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TypedTerm term q typ _) = printText0 ga term
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga q
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga typ
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (QuantifiedTerm q vs t _) = printText0 ga q
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga vs
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> text dotS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (LambdaTerm ps q t _) = text lamS
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder <+> (case ps of
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder [p] -> printText0 ga p
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder _ -> fcat $ map
9737bb5d563d68e87ce8e38ca533388118d90d2dChristian Maeder (parens.printText0 ga) ps)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> (case q of
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder Partial -> text dotS
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder Total -> text $ dotS ++ exMark)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (CaseTerm t es _ ) = text caseS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> text ofS
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> vcat (punctuate (text " | ")
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (map (printEq0 ga funS) es))
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (LetTerm es t _) = text letS
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> vcat (punctuate semi
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (map (printEq0 ga equalS) es))
e05956d1da3c97e4d808926f97c6841c4a561991Christian Maeder <+> text inS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TermToken t) = printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (MixfixTerm ts) = fsep $ map (printText0 ga) ts
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (BracketTerm k l _) = bracket k $ commaT_text ga l
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint Pattern where
aa60342b6a000c6798730e1b1ddeec846254c62cChristian Maeder printText0 ga (PatternVar v) = printText0 ga v
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder printText0 ga (PatternConstr n t _) = printText0 ga n
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder <+> colon
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder <+> printText0 ga t
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder printText0 ga (ResolvedMixPattern n args _) =
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder (if isSimpleId n then id else parens) (printText0 ga n)
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder <> (case args of
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder [] -> empty
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder [t@(TuplePattern _ _)] ->
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder printText0 ga t
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder _ -> parens $ commaT_text ga args)
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder printText0 ga (ApplPattern p1 p2 _) = printText0 ga p1
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder <+> (case p2 of
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder TuplePattern _ _ -> id
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder BracketPattern Parens _ _ -> id
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder ResolvedMixPattern _ [] _ -> id
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder PatternToken _ -> id
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder _ -> parens) (printText0 ga p2)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (TuplePattern ps _) = parens $ commaT_text ga ps
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TypedPattern p t _) = printText0 ga p
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (AsPattern v p _) = printText0 ga v
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder <+> text asP
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga p
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder printText0 ga (PatternToken t) = printText0 ga t
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder printText0 ga (BracketPattern k l _) = bracket k $ commaT_text ga l
6f6c328eca52553e8c921565950fdddadc799bf7Christian Maeder printText0 ga (MixfixPattern ps) = fsep (map (printText0 ga) ps)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder-- | print an equation with different symbols between 'Pattern' and 'Term'
c4e912fc181d72c8d0e0e38d0351278182f0d0b5Christian MaederprintEq0 :: GlobalAnnos -> String -> ProgEq -> Doc
86c119e3e74ba4b1b4ca728531282e9100789939Christian MaederprintEq0 ga s (ProgEq p t _) = fsep [printText0 ga p
c0467970183fa3dc894edea3caf9ca05d3a09fa8Christian Maeder , text s
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder , printText0 ga t]
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint VarDecl where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (VarDecl v t _ _) = printText0 ga v <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederinstance PrettyPrint GenVarDecl where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (GenVarDecl v) = printText0 ga v
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (GenTypeVarDecl tv) = printText0 ga tv
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint TypeArg where
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder printText0 ga (TypeArg v c _ _) = printText0 ga v <+> colon
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder <+> printText0 ga c
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
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 [] -> empty
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder [x] -> printText0 ga x
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder _ -> parens $ commaT_text ga l
da245da15da78363c896e44ea97a14ab1f83eb50Christian Maeder
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)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder------------------------------------------------------------------------
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder-- item stuff
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 Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint BasicSpec where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (BasicSpec l) = vcat (map (printText0 ga) l)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint ProgEq where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga = printEq0 ga equalS
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint BasicItem where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (SigItems s) = printText0 ga s
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (ProgItems l _) = text programS <+> semiT_text ga l
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (ClassItems i l _) = text classS <+> printText0 ga i
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga l
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (GenVarItems l _) = text varS <+> semiT_text ga l
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (FreeDatatype l _) = text freeS <+> text typeS
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga l
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (GenItems l _) = text generatedS <+> braces (semiT_text ga l)
d24cb84dba35006c81c22c0fc4215f63c22858efChristian Maeder printText0 ga (AxiomItems vs fs _) = (if null vs then empty
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder else text forallS <+> semiT_text ga vs)
d24cb84dba35006c81c22c0fc4215f63c22858efChristian Maeder $$ vcat (map
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (\x -> text dotS <+> printText0 ga x)
c0467970183fa3dc894edea3caf9ca05d3a09fa8Christian Maeder fs)
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (Internal l _) = text internalS <+> braces (semiT_text ga l)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint SigItems where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (TypeItems i l _) = text typeS <+> printText0 ga i
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <+> semiT_text ga l
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (OpItems l _) = text opS <+> semiT_text ga l
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint Instance where
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Instance = text instanceS
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ _ = empty
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
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 Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint ClassDecl where
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder printText0 ga (ClassDecl l k _) = commaT_text ga l
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder <+> text lessS <+> printText0 ga k
ae464ac109d82566feab1acbc98eab3bf1f10bb3Christian Maeder
37e2067019ef1e30bc7ad98b9bc623aa41cfa980Christian Maederinstance PrettyPrint Vars where
37e2067019ef1e30bc7ad98b9bc623aa41cfa980Christian Maeder printText0 ga (Var v) = printText0 ga v
37e2067019ef1e30bc7ad98b9bc623aa41cfa980Christian Maeder printText0 ga (VarTuple vs _) = parens $ commaT_text ga vs
37e2067019ef1e30bc7ad98b9bc623aa41cfa980Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint TypeItem where
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (TypeDecl l k _) = commaT_text ga l <>
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder printKind ga k
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (SubtypeDecl l t _) = commaT_text ga l <+> text lessS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (IsoDecl l _) = cat(punctuate (text " = ")
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder (map (printText0 ga) l))
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (SubtypeDefn p v t f _) = printText0 ga p
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text equalS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> braces (printText0 ga v
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text dotS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga f)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (AliasType p k t _) = (printText0 ga p <>
715a002611e0c503c11cc3aa80835763215e689dChristian Maeder case k of
715a002611e0c503c11cc3aa80835763215e689dChristian Maeder Nothing -> empty
14b47f7dabb39996a31c7286810a5897587aed3aChristian Maeder Just j -> space <> colon <+>
24c4e80d78a5810e2713076736a23728f9f99235Christian Maeder printText0 ga j)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text assignS
51281dddda866c0cda9fca22bf6bc4eea7128112Christian Maeder <+> printPseudoType ga t
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (Datatype t) = printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint OpItem where
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (OpDecl l t as _) = commaT_text ga l <+> colon
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> (printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <> (if null as then empty else comma)
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder <> commaT_text ga as)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (OpDefn n ps s p t _) = (printText0 ga n
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <> fcat (map (printText0 ga) ps))
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> (colon <> if p == Partial
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder then text quMark else empty)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga s
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder <+> text equalS
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint BinOpAttr where
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Assoc = text assocS
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Comm = text commS
4e1eee47e914d754644cc396647b6997a28d3704Christian Maeder printText0 _ Idem = text idemS
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint OpAttr where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (BinOpAttr a _) = printText0 ga a
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (UnitOpAttr t _) = text unitS <+> printText0 ga t
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
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 Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint Alternative where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (Constructor n cs p _) = printText0 ga n
9db0c1ce4c2629ac4b405cda10a33d5c26712ba6Christian Maeder <+> fsep (map (printText0 ga) cs)
9db0c1ce4c2629ac4b405cda10a33d5c26712ba6Christian Maeder <+> (case p of {Partial -> text quMark;
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder _ -> empty})
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (Subtype l _) = text typeS <+> commaT_text ga l
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maederinstance PrettyPrint Components where
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (Selector n p t _ _) = printText0 ga n
c0467970183fa3dc894edea3caf9ca05d3a09fa8Christian Maeder <> colon <> (case p of { Partial ->text quMark;
c0467970183fa3dc894edea3caf9ca05d3a09fa8Christian Maeder _ -> empty }
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder <+> printText0 ga t)
86c119e3e74ba4b1b4ca728531282e9100789939Christian Maeder printText0 ga (NoSelector t) = printText0 ga t
712f5e5ca1c3a5cfdd28518154ecf2dd0994cdb5Christian Maeder printText0 ga (NestedComponents l _) = parens $ semiT_text ga l
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder
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)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder