Print_AS.hs revision 2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederModule : $Header$
5ba323da9f037264b4a356085e844889aedeac23Christian MaederCopyright : DFKI GmbH 2009
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian MaederMaintainer : codruta.liliana@gmail.com
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : experimental
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederPortability : portable
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maederprinting AS_ExtModal ExtModalSign data types
fc8c6570c7b4ee13f375eb607bed2290438573bfChristian Maederimport qualified Common.Lib.MapSet as MapSet
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederimport qualified Data.Map as Map
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maederimport qualified Data.Set as Set
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maederimport CASL.AS_Basic_CASL (FORMULA(..))
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maederinstance Pretty EM_BASIC_ITEM where
af621d0066770895fd79562728e93099c8c52060Christian Maeder pretty (Simple_mod_decl time id_list ax_list _) =
7c554e9d4a39b8eb3b0881f20807c95dd8e793aeChristian Maeder cat[if time then (keyword timeS) else empty
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder , keyword modalityS <+> semiAnnos pretty id_list
79d11c2e3ad242ebb241f5d4a5e98a674c0b986fChristian Maeder , space <> specBraces (semiAnnos pretty ax_list)]
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder pretty (Nominal_decl id_list _) = keyword nominalS <+> semiAnnos pretty id_list
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maederinstance Pretty MODALITY where
e13ee09381f136f5eadaabdb9699773c0052cf3dChristian Maeder pretty (Simple_modality idt) = pretty idt
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maeder pretty (Composition md1 md2) = (keyword tmOParanthS) <> (pretty md1) <>
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder (keyword tmCompositionS) <> (pretty md2)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder <> (keyword tmCParanthS)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder pretty (Union md1 md2) = (keyword tmOParanthS) <> (pretty md1) <> (keyword tmUnionS)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder <> (pretty md2) <> (keyword tmCParanthS)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder pretty (TransitiveClosure md) = (keyword tmOParanthS) <> (pretty md) <>
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder (keyword (tmTransClosS ++ tmCParanthS))
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder pretty (Guard sen) = (keyword tmOParanthS) <> (pretty sen) <> (keyword (tmGuardS ++ tmCParanthS))
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederinstance Pretty RIGOR where
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder pretty Rigid = keyword rigidS
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder pretty Flexible = keyword flexibleS
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maederinstance Pretty EM_SIG_ITEM where
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder pretty (Rigid_op_items rig op_list _) =
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder cat [pretty rig <+> keyword (opS ++ pluralS op_list),
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder space <> semiAnnos pretty op_list]
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder pretty (Rigid_pred_items rig pred_list _) =
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder cat [pretty rig <+> keyword (predS ++ pluralS pred_list),
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder space <> semiAnnos pretty pred_list]
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederinstance Pretty NOMINAL where
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder pretty (Nominal idt) = pretty idt
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maederinstance FormExtension EM_FORMULA
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maederinstance Pretty EM_FORMULA where
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder pretty (BoxOrDiamond choice modality leq_geq number em_sentence _) =
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder let sp = case modality of
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder Simple_modality _ -> (<>)
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder mdl = pretty modality
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder in sep $ (if choice then brackets mdl else less `sp` mdl `sp` greater)
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder : (if leq_geq then keyword lessEq else keyword greaterEq)
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder : (text (show number)) : space : [condParensInnerF printFormula parens em_sentence]
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder pretty (Hybrid choice nom em_sentence _) =
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder sep $ (if choice then keyword atS else keyword hereS) : space : (pretty nom) : space
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder : [condParensInnerF printFormula parens em_sentence]
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder pretty (UntilSince choice sentence1 sentence2 _) =
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder sep $ ([condParensInnerF printFormula parens sentence1]
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder ++ ( space : (if choice then keyword untilS else keyword sinceS) : space
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder : [condParensInnerF printFormula parens sentence2]))
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder pretty (PathQuantification choice em_sentence _) =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder sep $ (if choice then keyword allPathsS else keyword somePathsS) : space
792df0347edab377785d98c63e2be8e2ce0a8bdeChristian Maeder : [condParensInnerF printFormula parens em_sentence]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder pretty (NextY choice em_sentence _) =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder sep $ (if choice then keyword nextS else keyword yesterdayS) : space
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder : [condParensInnerF printFormula parens em_sentence]
d976ba42e9d48c289f9c73147669c7e57b7aa98eChristian Maeder pretty (StateQuantification dir_choice choice em_sentence _) =
d976ba42e9d48c289f9c73147669c7e57b7aa98eChristian Maeder let kw = case dir_choice of
986e0e9cf8c2358f455460b3fc75ce7c5dcf0973Christian Maeder True -> if choice then keyword generallyS else keyword eventuallyS
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder _ -> if choice then keyword hithertoS else keyword previouslyS
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder in sep $ kw : space : [condParensInnerF printFormula parens em_sentence]
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder pretty (FixedPoint choice p_var em_sentence _) =
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder sep $ (if choice then keyword muS else keyword nuS) : space : (pretty p_var) : space
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder : [condParensInnerF printFormula parens em_sentence]
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian MaedercondParensInnerF :: Pretty f => (FORMULA f -> Doc) -> (Doc -> Doc) -> FORMULA f -> Doc
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian MaedercondParensInnerF frm_print parens_fun frm =
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder Quantification _ _ _ _ -> frm'
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder True_atom _ -> frm'
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder False_atom _ -> frm'
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Predication _ _ _ -> frm'
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Definedness _ _ -> frm'
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Existl_equation _ _ _ -> frm'
0a320bc4cdbf38f480b75ac15a54db1c4885b497Christian Maeder Strong_equation _ _ _ -> frm'
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder Membership _ _ _ -> frm'
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder ExtFORMULA _ -> frm'
0a320bc4cdbf38f480b75ac15a54db1c4885b497Christian Maeder _ -> parens_fun frm'
5334aa8fe0b0d1eb8a1cad40b741aa07172773c9Christian Maeder where frm' = frm_print frm
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maederinstance Pretty EModalSign where
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder pretty = printEModalSign id
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaederprintEModalSign :: (FORMULA EM_FORMULA -> FORMULA EM_FORMULA) -> EModalSign
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaederprintEModalSign sim sign =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder let mds = modalities sign
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder tms = time_modalities sign
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder nms = nominals sign in
5334aa8fe0b0d1eb8a1cad40b741aa07172773c9Christian Maeder printSetMap (keyword rigidS <+> keyword opS) empty
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder (MapSet.toMap $ rigidOps sign)
5334aa8fe0b0d1eb8a1cad40b741aa07172773c9Christian Maeder printSetMap (keyword rigidS <+> keyword predS) empty
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder (MapSet.toMap $ rigidPreds sign)
5334aa8fe0b0d1eb8a1cad40b741aa07172773c9Christian Maeder (if Map.null mds then empty else
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder cat [keyword modalitiesS <+> sepBySemis (map sidDoc (Map.keys mds))
5334aa8fe0b0d1eb8a1cad40b741aa07172773c9Christian Maeder , specBraces (printFormulaOfEModalSign sim $ Map.elems mds)])
5334aa8fe0b0d1eb8a1cad40b741aa07172773c9Christian Maeder (if Set.null tms then empty else
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder keyword timeS <+> keyword modalitiesS
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder <+> sepBySemis (map sidDoc (Set.toList tms)))
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder (if Set.null nms then empty else
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder keyword nominalsS <+> sepBySemis (map sidDoc (Set.toList nms)))
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederprintFormulaOfEModalSign :: FormExtension f => (FORMULA f -> FORMULA f)
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maeder -> [[Annoted (FORMULA f)]] -> Doc
36c6cc568751e4235502cfee00ba7b597dae78dcChristian MaederprintFormulaOfEModalSign sim = vcat . map
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder (sepBySemis . map (printAnnoted $ pretty . sim))