PrintAs.hs revision f3a94a197960e548ecd6520bb768cb0d547457bb
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder{- |
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachModule : $Header$
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerCopyright : (c) Christian Maeder and Uni Bremen 2003
e071fb22ea9923a2a4ff41184d80ca46b55ee932Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : maeder@tzi.de
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus RoggenbachStability : experimental
b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiPortability : portable
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbachprinting data types of the abstract syntax
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach-}
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbachmodule HasCASL.PrintAs where
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport HasCASL.As
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.Keywords
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport HasCASL.HToken
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.Lib.Pretty
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.Id
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.PPUtils
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.PrettyPrint
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.GlobalAnnotations(GlobalAnnos)
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyimport Common.AS_Annotation(mapAnM)
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly-- | short cut for: if b then empty else d
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'ReillynoPrint :: Bool -> Doc -> Doc
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'ReillynoPrint b d = if b then empty else d
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyinstance PrettyPrint Variance where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 _ v = text $ show v
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyinstance PrettyPrint Kind where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 ga knd = case knd of
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly Intersection [] _ -> text "Type"
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly MissingKind -> space
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly ClassKind ci _ -> printText0 ga ci
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly Downset mt t _ _ ->
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly let tok = case mt of
01008b4f7e0076702f9cd61cb41bc02142c34375Christian Maeder Nothing -> text "_"
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly Just x -> text (tokStr x) <+> text dotS <+> text (tokStr x)
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly in braces (tok <+>
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly text lessS <+> printText0 ga t)
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly Intersection ks _ -> printList0 ga ks
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach FunKind k1 k2 _ ->
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder (case k1 of
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder FunKind _ _ _ -> parens
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> id) (printText0 ga k1)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder <+> text funS
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder <+> printText0 ga k2
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder ExtKind k v _ -> (case k of
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly FunKind _ _ _ -> parens
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly _ -> id) (printText0 ga k) <> printText0 ga v
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly
fd8af3ecf2dff782cb2496c1c9bf9d0a76faa98bLiam O'Reillyinstance PrettyPrint TypePattern where
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder printText0 ga tp = case tp of
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder TypePattern name args _ -> printText0 ga name
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly <> fcat (map (parens . printText0 ga) args)
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly TypePatternToken t -> printText0 ga t
d3c9318c22fcf44d9135a3b2c64f880b9a785babChristian Maeder MixfixTypePattern ts -> fsep (map (printText0 ga) ts)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly BracketTypePattern k l _ -> bracket k $ commaT_text ga l
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly TypePatternArg t _ -> parens $ printText0 ga t
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly-- | put proper brackets around a document
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maederbracket :: BracketKind -> Doc -> Doc
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maederbracket b t = let (o,c) = getBrackets b in text o <> t <> text c
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder-- | print a 'Kind' plus a preceding colon (or nothing for 'star')
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian MaederprintKind :: GlobalAnnos -> Kind -> Doc
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian MaederprintKind ga kind = case kind of
90047eafd2de482c67bcd13103c6064e9b0cb254Andy Gimblett Intersection [] _ -> empty
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder Downset Nothing t _ _ ->
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder space <> text lessS <+> printText0 ga t
d04c328b10f17ec78001a94d694f7188ebd8c03cAndy Gimblett _ -> space <> colon <+> printText0 ga kind
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly
90047eafd2de482c67bcd13103c6064e9b0cb254Andy Gimblettinstance PrettyPrint Type where
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly printText0 ga ty = case ty of
2650e8a56cc2381719bd2390fdf82402e0c696d8Christian Maeder TypeName name _k i -> printText0 ga name <>
2650e8a56cc2381719bd2390fdf82402e0c696d8Christian Maeder if i == 0 then empty else text ("_v"++ show i)
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder TypeAppl t1 t2 -> case t1 of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly TypeName (Id [a, Token "__" _, b] [] []) _ _ ->
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly printText0 ga a <> printText0 ga t2 <> printText0 ga b
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder TypeAppl (TypeName (Id [Token "__" _, inTok, Token "__" _]
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder [] []) _ _) t0 -> printText0 ga t0
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly <+> printText0 ga inTok <+> printText0 ga t2
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> (case t1 of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder TypeName _ _ _ -> id
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder TypeToken _ -> id
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder BracketType _ _ _ -> id
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder TypeAppl _ _ -> id
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder _ -> parens) (printText0 ga t1) <+>
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly (case t2 of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly TypeName _ _ _ -> id
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder TypeToken _ -> id
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly BracketType _ _ _ -> id
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> parens) (printText0 ga t2)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly ExpandedType t1 t2 -> printText0 ga t1 <> (case t2 of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder ProductType [] _ -> empty
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> text asP <> parens (printText0 ga t2))
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder TypeToken t -> printText0 ga t
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder BracketType k l _ -> bracket k $ commaT_text ga l
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder KindedType t kind _ -> (case t of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly FunType _ _ _ _ -> parens
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly ProductType [] _ -> id
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett ProductType _ _ -> parens
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly LazyType _ _ -> parens
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly TypeAppl _ _ -> parens
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly _ -> id) (printText0 ga t)
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett <+> colon <+> printText0 ga kind
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett MixfixType ts -> fsep (map (printText0 ga) ts)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly LazyType t _ -> text quMark <+> (case t of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly FunType _ _ _ _ -> parens
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder ProductType [] _ -> id
2650e8a56cc2381719bd2390fdf82402e0c696d8Christian Maeder ProductType _ _ -> parens
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder KindedType _ _ _ -> parens
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly _ -> id) (printText0 ga t)
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly ProductType ts _ -> if null ts then text "Unit"
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly -- parens empty
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly else fsep (punctuate (space <> char '*')
b6e474220ddcf68a75ca3dc26093c5ac21e31747Christian Maeder (map ( \ t ->
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett (case t of
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly FunType _ _ _ _ -> parens
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly ProductType [] _ -> id
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly ProductType _ _ -> parens
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly _ -> id) $ printText0 ga t) ts))
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly FunType t1 arr t2 _ -> (case t1 of
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly FunType _ _ _ _ -> parens
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly _ -> id) (printText0 ga t1)
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly <+> printText0 ga arr
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly <+> printText0 ga t2
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly-- no curried notation for bound variables
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reillyinstance PrettyPrint TypeScheme where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 ga (TypeScheme vs t _) = let tdoc = printText0 ga t in
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly if null vs then tdoc else
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly hang (text forallS <+> semiT_text ga vs <+> text dotS) 2 tdoc
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reillyinstance PrettyPrint Instance where
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly printText0 _ i = case i of
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly Instance -> space <> text instanceS
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly Plain -> empty
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyinstance PrettyPrint Partiality where
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly printText0 _ p = case p of
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly Partial -> text quMark
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly Total -> empty
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reilly
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'Reillyinstance PrettyPrint Arrow where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 _ a = text $ show a
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyinstance PrettyPrint Quantifier where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 _ q = text $ show q
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyinstance PrettyPrint TypeQual where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 _ q = text $ show q
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reillyinstance PrettyPrint Term where
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly printText0 ga t = printTerm ga
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly (case t of
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly QualVar _ -> True
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly QualOp _ _ _ _ -> True
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly _ -> False) t
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'ReillyunPredType :: Type -> Type
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'ReillyunPredType t = case t of
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly FunType ty PFunArr (TypeName
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly (Id [Token "Unit" _] [] _)
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly (Intersection [] _) 0) _ -> ty
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly _ -> t
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly
baba0fc1bc5847a1b084c03b8895097649a25a46Liam O'ReillyunPredTypeScheme :: TypeScheme -> TypeScheme
e771539425f4a0abef9f94cf4b63690f3603f682Andy GimblettunPredTypeScheme = mapTypeOfScheme unPredType
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett
d326dac41dadbe2b84bb7021cbfd91f4dd4a19bcAndy GimblettprintTerm :: GlobalAnnos -> Bool -> Term -> Doc
d297a45fc73aa6c4a1f9d073c3170611415f324bAndy GimblettprintTerm ga b trm =
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder let ppParen = if b then parens else id
a79fe3aad8743ea57e473ea5f66a723244cb9c0eMarkus Roggenbach commaT = fsep . punctuate comma . map (printTerm ga False)
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder printApplTerm t = printTerm ga (case t of
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reilly ApplTerm _ _ _ -> False
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder TermToken _ -> False
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly ResolvedMixTerm _ _ _ -> False
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly _ -> True) t
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly in
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder (case trm of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder TupleTerm _ _ -> id
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder BracketTerm _ _ _ -> id
929190acb9f2b2f5857dce841c5a389710895515Andy Gimblett TermToken _ -> id
fd8af3ecf2dff782cb2496c1c9bf9d0a76faa98bLiam O'Reilly MixTypeTerm _ _ _ -> id
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder _ -> ppParen)
cdf1545bdcd39a9d53c00761ffa42e7b1174b91eLiam O'Reilly $ case trm of
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly QualVar vd -> text varS <+> printText0 ga vd
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly QualOp br n t _ -> sep [printText0 ga br <+> printText0 ga n,
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder colon <+> printText0 ga
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly (if isPred br then unPredTypeScheme t else t)]
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy Gimblett ResolvedMixTerm n ts _ ->
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett case ts of
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett [] -> printText0 ga n
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy Gimblett [t] -> printText0 ga n <> printTerm ga True t
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy Gimblett _ -> printText0 ga n <> parens (commaT ts)
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett ApplTerm t1 t2 _ ->
e54c5af823b9775dd2c058185ea5bdf7593950faAndy Gimblett cat [printApplTerm t1, nest 2 $ printTerm ga True t2]
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder TupleTerm ts _ -> parens (commaT ts)
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder TypedTerm t q typ _ -> hang (printApplTerm t <+> printText0 ga q)
afd6ed16928bbd774b6c6c5b3f440a917dd638a1Andy Gimblett 4 $ printText0 ga typ
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly QuantifiedTerm q vs t _ -> hang (printText0 ga q <+> semiT_text ga vs)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly 2 (text dotS <+> printText0 ga t)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly LambdaTerm ps q t _ -> hang (text lamS <+> (case ps of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly [p] -> printText0 ga p
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder _ -> fcat $ map (parens . printTerm ga False) ps))
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly 2 ((case q of
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder Partial -> text dotS
67e234eb781dd16dfd269486befd2b5781075079Christian Maeder Total -> text $ dotS ++ exMark) <+> printText0 ga t)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly CaseTerm t es _ -> hang (text caseS <+> printText0 ga t <+> text ofS)
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly 4 $ vcat (punctuate (text " | ") $ map (printEq0 ga funS) es)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder LetTerm br es t _ ->
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder let dt = printText0 ga t
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder des = vcat $ punctuate semi $ map (printEq0 ga equalS) es
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly in case br of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Let -> sep [text letS <+> des, text inS <+> dt]
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Where -> hang (sep [dt, text whereS]) 6 des
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder Program -> text programS <+> des
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder TermToken t -> printText0 ga t
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly MixTypeTerm q t _ -> printText0 ga q <+> printText0 ga t
096d1f4ecffdbaa9e8543b712f24a636ba5accffLiam O'Reilly MixfixTerm ts -> fsep $ map (printText0 ga) ts
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly BracketTerm k l _ -> bracket k $ commaT l
f08f7774e4c47012f3c349205310750198cdc434Liam O'Reilly AsPattern v p _ -> printText0 ga v <+> text asP <+> printText0 ga p
7dc79552823b00bdd0dd75fcd2ab9af541c71650Christian Maeder
7dc79552823b00bdd0dd75fcd2ab9af541c71650Christian Maeder-- | print an equation with different symbols between 'Pattern' and 'Term'
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederprintEq0 :: GlobalAnnos -> String -> ProgEq -> Doc
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederprintEq0 ga s (ProgEq p t _) =
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder hang (hang (printText0 ga p) 2 $ text s) 4 $ printText0 ga t
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reilly
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reillyinstance PrettyPrint VarDecl where
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly printText0 ga (VarDecl v t _ _) = printText0 ga v <>
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder case t of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly MixfixType [] -> empty
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder _ -> space <> colon <+> printText0 ga t
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder
842ae753ab848a8508c4832ab64296b929167a97Christian Maederinstance PrettyPrint GenVarDecl where
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder printText0 ga gvd = case gvd of
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder GenVarDecl v -> printText0 ga v
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder GenTypeVarDecl tv -> printText0 ga tv
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reillyinstance PrettyPrint TypeArg where
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reilly printText0 ga (TypeArg v c _ _) =
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder printText0 ga v <+> colon <+> printText0 ga c
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder-- | don't print an empty list and put parens around longer lists
f08f7774e4c47012f3c349205310750198cdc434Liam O'ReillyprintList0 :: (PrettyPrint a) => GlobalAnnos -> [a] -> Doc
eaf34cf96fbfcdcce7f3bdb322c4ea7ebd1fd220Liam O'ReillyprintList0 ga l = case l of
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly [] -> empty
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly [x] -> printText0 ga x
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly _ -> parens $ commaT_text ga l
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reillyinstance PrettyPrint InstOpId where
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder printText0 ga (InstOpId n l _) = printText0 ga n <> noPrint (null l)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder (brackets $ semiT_text ga l)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder------------------------------------------------------------------------
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder-- item stuff
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder------------------------------------------------------------------------
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder-- | print a 'TypeScheme' as a pseudo type
842ae753ab848a8508c4832ab64296b929167a97Christian MaederprintPseudoType :: GlobalAnnos -> TypeScheme -> Doc
842ae753ab848a8508c4832ab64296b929167a97Christian MaederprintPseudoType ga (TypeScheme l t _) = noPrint (null l) (text lamS
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maeder <+> (if null $ tail l then printText0 ga $ head l
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maeder else fcat(map (parens . printText0 ga) l))
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maeder <+> text dotS <> space) <> printText0 ga t
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maeder
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maederinstance PrettyPrint BasicSpec where
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maeder printText0 ga (BasicSpec l) = vcat (map (printText0 ga) l)
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly
842ae753ab848a8508c4832ab64296b929167a97Christian Maederinstance PrettyPrint ProgEq where
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder printText0 ga = printEq0 ga equalS
2650e8a56cc2381719bd2390fdf82402e0c696d8Christian Maeder
2650e8a56cc2381719bd2390fdf82402e0c696d8Christian Maederinstance PrettyPrint BasicItem where
816c50f9135a598dfdcfb2af8a80390bc42a9b24Liam O'Reilly printText0 ga bi = case bi of
23b1275b6136c9dbec63d3ea87c697f2aa89a061Liam O'Reilly SigItems s -> printText0 ga s
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder ProgItems l _ -> noPrint (null l) $ text programS <+> semiT_text ga l
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder ClassItems i l _ -> noPrint (null l) $ text classS <> printText0 ga i
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> semiT_text ga l
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder GenVarItems l _ -> noPrint (null l) $ text varS <+> semiT_text ga l
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder FreeDatatype l _ -> noPrint (null l) $ text freeS <+> text typeS
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> semiT_text ga l
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder GenItems l _ -> noPrint (null l) $ text generatedS
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> braces (semiT_text ga l)
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder AxiomItems vs fs _ -> (noPrint (null vs) $ text forallS
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> semiT_text ga vs)
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder $$ vcat (map ( \ x -> text dotS
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> printText0 ga x) fs)
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder Internal l _ -> noPrint (null l) $ text internalS
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> braces (semiT_text ga l)
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maederinstance PrettyPrint OpBrand where
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder printText0 _ b = text $ show b
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maederinstance PrettyPrint SigItems where
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder printText0 ga si = case si of
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder TypeItems i l _ -> noPrint (null l) $ text typeS <> printText0 ga i
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder <+> semiT_text ga l
de16f2cd7bef567000c39b40e6f7b0b263e49d12Christian Maeder OpItems b l _ -> noPrint (null l) $ printText0 ga b <+> semiT_text ga
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly (if isPred b then concat $
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder mapAnM ((:[]) . mapOpItem) l else l)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reillyinstance PrettyPrint ClassItem where
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly printText0 ga (ClassItem d l _) = printText0 ga d $$
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder if null l then empty
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder else braces (semiT_text ga l)
842ae753ab848a8508c4832ab64296b929167a97Christian Maeder
842ae753ab848a8508c4832ab64296b929167a97Christian Maederinstance PrettyPrint ClassDecl where
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder printText0 ga (ClassDecl l k _) = commaT_text ga l
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder <+> text lessS <+> printText0 ga k
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly
bcd914850de931848b86d7728192a149f9c0108bChristian Maederinstance PrettyPrint Vars where
d3c9318c22fcf44d9135a3b2c64f880b9a785babChristian Maeder printText0 ga vd = case vd of
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder Var v -> printText0 ga v
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder VarTuple vs _ -> parens $ commaT_text ga vs
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maederinstance PrettyPrint TypeItem where
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder printText0 ga ti = case ti of
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly TypeDecl l k _ -> if null l then error "printText0 TypeDecl" else
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder commaT_text ga l <> printKind ga k
f284db6f4dffd7bf60b82319648efb7bcb9378c9Christian Maeder SubtypeDecl l t _ -> if null l then error "printText0 SubtypeDecl"
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly else commaT_text ga l <+> text lessS <+> printText0 ga t
8c6b80162937eae0fe868c3b52bda6b50a153478Christian Maeder IsoDecl l _ -> cat(punctuate (text " = ")
8c6b80162937eae0fe868c3b52bda6b50a153478Christian Maeder (map (printText0 ga) l))
8c6b80162937eae0fe868c3b52bda6b50a153478Christian Maeder SubtypeDefn p v t f _ -> printText0 ga p
8c6b80162937eae0fe868c3b52bda6b50a153478Christian Maeder <+> text equalS
8c6b80162937eae0fe868c3b52bda6b50a153478Christian Maeder <+> braces (printText0 ga v
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder <+> colon
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder <+> printText0 ga t
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly <+> text dotS
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'Reilly <+> printText0 ga f)
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder AliasType p k t _ -> (printText0 ga p <>
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder case k of
bcd914850de931848b86d7728192a149f9c0108bChristian Maeder Nothing -> empty
Just j -> space <> colon <+>
printText0 ga j)
<+> text assignS
<+> printPseudoType ga t
Datatype t -> printText0 ga t
mapOpItem :: OpItem -> OpItem
mapOpItem oi = case oi of
OpDecl l t as ps -> OpDecl l (unPredTypeScheme t) as ps
OpDefn n ps s p t qs -> OpDefn n ps (unPredTypeScheme s) p t qs
instance PrettyPrint OpItem where
printText0 ga oi = case oi of
OpDecl l t attrs _ -> if null l then error "printText0 OpDecl" else
commaT_text ga l <+> colon <+> (printText0 ga t
<> (if null attrs then empty else comma <> space)
<> commaT_text ga attrs)
OpDefn n ps s p t _ -> hang
(hang (printText0 ga n <> fcat (map (parens . semiT_text ga) ps))
2 (colon <> printText0 ga p
<+> printText0 ga s))
2 (text equalS
<+> printText0 ga t)
instance PrettyPrint BinOpAttr where
printText0 _ a = text $ case a of
Assoc -> assocS
Comm -> commS
Idem -> idemS
instance PrettyPrint OpAttr where
printText0 ga oa = case oa of
BinOpAttr a _ -> printText0 ga a
UnitOpAttr t _ -> text unitS <+> printText0 ga t
instance PrettyPrint DatatypeDecl where
printText0 ga (DatatypeDecl p k alts d _) = (printText0 ga p <>
printKind ga k)
<+> text defnS
<+> vcat(punctuate (text " | ")
(map (printText0 ga) alts))
<+> case d of [] -> empty
_ -> text derivingS
<+> commaT_text ga d
instance PrettyPrint Alternative where
printText0 ga alt = case alt of
Constructor n cs p _ ->
printText0 ga n <+> fsep (map (parens . semiT_text ga) cs)
<> printText0 ga p
Subtype l _ -> noPrint (null l) $ text typeS <+> commaT_text ga l
instance PrettyPrint Component where
printText0 ga sel = case sel of
Selector n p t _ _ -> printText0 ga n
<+> colon <> printText0 ga p
<+> printText0 ga t
NoSelector t -> printText0 ga t
instance PrettyPrint OpId where
printText0 ga (OpId n ts _) = printText0 ga n
<+> noPrint (null ts)
(brackets $ commaT_text ga ts)
instance PrettyPrint Symb where
printText0 ga (Symb i mt _) =
printText0 ga i <> (case mt of Nothing -> empty
Just (SymbType t) ->
empty <+> colon <+>
printText0 ga t)
instance PrettyPrint SymbItems where
printText0 ga (SymbItems k syms _ _) =
printSK k <> commaT_text ga syms
instance PrettyPrint SymbOrMap where
printText0 ga (SymbOrMap s mt _) =
printText0 ga s <> (case mt of Nothing -> empty
Just t ->
empty <+> text mapsTo <+>
printText0 ga t)
instance PrettyPrint SymbMapItems where
printText0 ga (SymbMapItems k syms _ _) =
printSK k <> commaT_text ga syms
-- | print symbol kind
printSK :: SymbKind -> Doc
printSK k =
case k of Implicit -> empty
_ -> text (drop 3 $ show k) <> space