Print.hs revision 0474b351d3032a8e52305e1499ec0e724c5d489d
c797f343be2f3619bb1f5569753166ec49d27bdbChristian MaederModule : $Header$
81d182b21020b815887e9057959228546cf61b6bChristian MaederDescription : pretty printing ADL syntax
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian MaederCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : GPLv2 or higher
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
c797f343be2f3619bb1f5569753166ec49d27bdbChristian MaederStability : provisional
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian MaederPortability : portable
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maedermodule Adl.Print (adlGA) where
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maederimport qualified Data.Map as Map
23a00c966f2aa8da525d7a7c51933c99964426c0Christian Maederinstance Pretty Concept where
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder pretty c = case c of
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder C s -> pretty s
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder _ -> text $ show c
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maederinstance Pretty Relation where
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder pretty (Sgn n c1 c2) = let s = tokStr n in
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder (if isBRel s then keyword s else pretty n)
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian Maeder <> case (c1, c2) of
b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder (Anything, Anything) -> empty
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder _ | c1 == c2 -> brackets $ pretty c1
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder _ -> brackets $ hcat [pretty c1, cross, pretty c2]
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaederpOp :: UnOp -> Id
89054b2b95a3f92e78324dc852f3d34704e2ca49Christian MaederpOp o = case o of
b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder Co -> converseId
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder Cp -> minusId
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder _ -> stringToId $ show o
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maederinstance Pretty UnOp where
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder pretty = idDoc . stringToId . show
b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian MaederinOp :: MulOp -> Id
59c301c268f79cfde0a4c30a2c572a368db98da5Christian MaederinOp = stringToId . show
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maederinstance Pretty MulOp where
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder pretty o = let i = idDoc (inOp o) in case o of
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder _ -> space <> i <> space
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaederprettyParen :: (Rule -> Bool) -> Rule -> Doc
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian MaederprettyParen p e = (if p e then parens else id) $ pretty e
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaederminusId = mkId [mkSimpleId $ show Cp, placeTok]
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian MaederconverseId :: Id
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian MaederconverseId = mkId [placeTok, mkSimpleId $ show Co]
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaederdisplayMap :: DisplayMap
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaederdisplayMap = Map.fromList $ map ( \ (i, l) -> (i, Map.singleton DF_LATEX l))
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder [ (minusId, [mkSimpleId "\\overline{", placeTok, mkSimpleId "}"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (converseId, [mkSimpleId "\\widetilde{", placeTok, mkSimpleId "}"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (inOp Fi, [mkSimpleId "\\cap"])
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder , (inOp Fu, [mkSimpleId "\\cup"])
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder , (inOp Fd, [mkSimpleId "\\dag"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (inOp Ri, [mkSimpleId "\\vdash"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (inOp Rr, [mkSimpleId "\\dashv"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (stringToId $ show Co, [mkSimpleId "{^\\smile}"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (pOp K0, [mkSimpleId "\\texttt{*}"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder , (pOp K1, [mkSimpleId "\\texttt{+}"])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaederadlGA :: GlobalAnnos
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian MaederadlGA = emptyGlobalAnnos
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder { display_annos = displayMap }
27912d626bf179b82fcb337077e5cd9653bb71cfChristian Maederinstance Pretty Rule where
ee6c748be810b24e3c70ffd74f291c7394e389f5Christian Maeder pretty e = useGlobalAnnos adlGA $ case e of
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder Tm r -> pretty r
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder MulExp o es ->
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder fcat . punctuate (pretty o) $ map
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder (prettyParen (\ a -> case a of
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder MulExp p _ -> p >= o || o == Rr && p == Ri
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder _ -> False)) es
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder UnExp o r -> (if o >= Cp
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder then idApplDoc (pOp o) . (: [])
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder else (<> pretty o))
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maeder $ prettyParen (\ a -> case a of
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder MulExp _ _ -> True
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder UnExp p _ -> o /= Cp && p == Cp
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder _ -> False) r
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maederinstance Pretty Prop where
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder pretty = text . showUp
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maederinstance Pretty RangedProp where
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder pretty = pretty . propProp
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maederinstance Pretty Object where
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maeder pretty (Object n e as os) = sep
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder [ fsep [commentText (tokStr n) <> colon, pretty e]
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder , if null as then empty else fsep $ keyword "ALWAYS" : map pretty as
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maeder , if null os then empty else equals <+> brackets (ppWithCommas os) ]
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maederinstance Pretty RuleKind where
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maeder pretty = keyword . showRuleKind
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maederinstance Pretty RuleHeader where
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder pretty h = case h of
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder Always -> empty
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder RuleHeader k t -> keyword
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder (if k == SignalOn then "SIGNAL" else "RULE")
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder <+> pretty t <+> pretty k
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maederinstance Pretty KeyAtt where
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder pretty (KeyAtt mt e) = sep [case mt of
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Nothing -> empty
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Just t -> pretty t <> colon
ad187062b0009820118c1b773a232e29b879a2faChristian Maederinstance Pretty KeyDef where
cdb141ee48c3a96e620186de94316c562037a2e0Christian Maeder pretty (KeyDef l c atts) = fsep
cdb141ee48c3a96e620186de94316c562037a2e0Christian Maeder [ keyword "KEY"
cdb141ee48c3a96e620186de94316c562037a2e0Christian Maeder , pretty l <> colon
b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder , parens $ ppWithCommas atts ]
cdb141ee48c3a96e620186de94316c562037a2e0Christian Maederinstance Pretty Pair where
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder pretty (Pair x y) = parens $ ppWithCommas [x, y]
cdb141ee48c3a96e620186de94316c562037a2e0Christian MaederprettyContent :: [Pair] -> Doc
59c301c268f79cfde0a4c30a2c572a368db98da5Christian MaederprettyContent = brackets . vcat . punctuate semi . map pretty
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maederinstance Pretty PatElem where
b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder pretty e = case e of
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder Pr k r -> pretty k <+> pretty r
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Pg c1 c2 -> fsep [keyword "GEN", pretty c1, keyword "ISA", pretty c2]
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Pk k -> pretty k
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Pm ps (Sgn n c1 c2) b ->
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder let u = rProp Uni
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder t = rProp Tot
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder f = elem u ps && elem t ps
cdb141ee48c3a96e620186de94316c562037a2e0Christian Maeder ns = if f then delete t $ delete u ps else ps
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder [ pretty n, text "::", pretty c1
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder , if f then funArrow else cross, pretty c2
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder , if null ns then empty else brackets $ ppWithCommas ns]
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder <> if b then empty else dot
32a7cc7177ecf70e35ec831ff86887b9acc40dcaChristian Maeder Plug p o -> sep [keyword $ showUp p, pretty o]
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder Population b r l -> let d = prettyContent l in
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder if b then equals <+> d <> dot else fsep
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder [ keyword "POPULATION"
e95bbf384f5cbcb7eb23286d5f15dffbd471db17Christian Maeder , keyword "CONTAINS"
15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maederinstance Pretty Context where
15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maeder pretty (Context m ps) = let l = vcat $ map pretty ps in case m of