Print_AS_Structured.hs revision e6d40133bc9f858308654afb1262b8b483ec5922
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian MaederModule : $Header$
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederDescription : pretty printing of CASL structured specifications
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederCopyright : (c) Klaus L�ttich, Uni Bremen 2002-2006
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
1549f3abf73c1122acff724f718b615c82fa3648Till MossakowskiMaintainer : luettich@tzi.de
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuStability : provisional
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederPortability : non-portable(Grothendieck)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederPretty printing of CASL structured specifications
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederstructSimpleId :: SIMPLE_ID -> Doc
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederstructSimpleId = structId . tokStr
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maederinstance Pretty SPEC where
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder pretty = printSPEC
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintUnion :: [Annoted SPEC] -> [Doc]
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintUnion = prepPunctuate (topKey andS <> space) . map condBracesAnd
b5056cf24da461ee868c4be7b803a76b677fa21dChristian MaedermoveAnnos :: Annoted SPEC -> [Annoted SPEC] -> [Annoted SPEC]
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaedermoveAnnos x l = appAnno $ case l of
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder [] -> error "moveAnnos"
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder h : r -> h { l_annos = l_annos x ++ l_annos h } : r
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder where appAnno a = case a of
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder [h] -> [appendAnno h (r_annos x)]
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder h : r -> h : appAnno r
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintOptUnion :: Annoted SPEC -> [Doc]
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintOptUnion x = case skipVoidGroup $ item x of
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Union e@(_ : _) _ -> printUnion $ moveAnnos x e
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Extension e@(_ : _) _ -> printExtension $ moveAnnos x e
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder _ -> [pretty x]
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintExtension :: [Annoted SPEC] -> [Doc]
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintExtension l = case l of
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder x : r -> printOptUnion x ++
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder concatMap (( \ (d : s) -> (topKey thenS <+> d) : s) .
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder printOptUnion) r
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintSPEC :: SPEC -> Doc
351391e0e3226210e7ffb183b334da9f96de36eaChristian MaederprintSPEC spec = case spec of
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Basic_spec aa -> pretty aa
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Translation aa ab -> sep [condBracesTransReduct aa, printRENAMING ab]
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Reduction aa ab -> sep [condBracesTransReduct aa, printRESTRICTION ab]
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Union aa _ ->
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder sep $ printUnion aa
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Extension aa _ ->
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder sep $ printExtension aa
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Free_spec aa _ -> sep [keyword freeS, printGroupSpec aa]
351391e0e3226210e7ffb183b334da9f96de36eaChristian Maeder Cofree_spec aa _ -> sep [keyword cofreeS, printGroupSpec aa]
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder Local_spec aa ab _ ->
f8b715ab2993083761c0aedb78f1819bcf67b6ccChristian Maeder fsep [keyword localS, pretty aa,
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder keyword withinS, condBracesWithin ab]
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder Closed_spec aa _ -> sep [keyword closedS, printGroupSpec aa]
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder Group aa _ -> pretty aa
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder Spec_inst aa ab _ ->
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder cat [structSimpleId aa, print_fit_arg_list ab]
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski Qualified_spec ln asp _ ->
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang printLogicEncoding ln <> colon $+$ (pretty asp)
23a00c966f2aa8da525d7a7c51933c99964426c0Christian Maeder Data _ _ s1 s2 _ -> keyword dataS <+> pretty s1 $+$ pretty s2
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maederinstance Pretty RENAMING where
8e9c3881fb6e710b1e08bf5ac8ff9d393df2e74eChristian Maeder pretty = printRENAMING
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian MaederprintRENAMING :: RENAMING -> Doc
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian MaederprintRENAMING (Renaming aa _) =
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder keyword withS <+> ppWithCommas aa
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiinstance Pretty RESTRICTION where
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder pretty = printRESTRICTION
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederprintRESTRICTION :: RESTRICTION -> Doc
90c174bac60a72ffd81bc3bf5ae2dd9a61943b8bChristian MaederprintRESTRICTION rest = case rest of
2561b4bfc45d280ee2be8a7870314670e4e682e4Christian Maeder Hidden aa _ -> keyword hideS <+> ppWithCommas aa
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettich Revealed aa _ -> keyword revealS <+> pretty aa
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus LuettichprintLogicEncoding :: (Pretty a) => a -> Doc
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederprintLogicEncoding enc = keyword logicS <+> pretty enc
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederinstance Pretty G_mapping where
c7e03d0708369f944b6f235057b39142a21599f2Mihai Codescu pretty = printG_mapping
986d3f255182539098a97ac86da9eeee5b7a72e3Christian MaederprintG_mapping :: G_mapping -> Doc
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederprintG_mapping gma = case gma of
8e80792f474d154ff11762fac081a422e34f1accChristian Maeder G_symb_map gsmil -> pretty gsmil
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder G_logic_translation enc -> printLogicEncoding enc
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederinstance Pretty G_hiding where
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder pretty = printG_hiding
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederprintG_hiding :: G_hiding -> Doc
16e124196c6b204769042028c74f533509c9b5d3Christian MaederprintG_hiding ghid = case ghid of
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder G_symb_list gsil -> pretty gsil
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder G_logic_projection enc -> printLogicEncoding enc
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maederinstance Pretty GENERICITY where
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder pretty = printGENERICITY
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian MaederprintGENERICITY :: GENERICITY -> Doc
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian MaederprintGENERICITY (Genericity aa ab _) = sep [printPARAMS aa, printIMPORTED ab]
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maederinstance Pretty PARAMS where
b2026c46f0e4c6a05931f1bf0ab2e84ce884c814Christian Maeder pretty = printPARAMS
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian MaederprintPARAMS :: PARAMS -> Doc
e6dccba746efe07338d3107fed512e713fd50b28Christian MaederprintPARAMS (Params aa) = cat $ map (brackets . rmTopKey . pretty ) aa
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maederinstance Pretty IMPORTED where
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder pretty = printIMPORTED
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederprintIMPORTED :: IMPORTED -> Doc
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian MaederprintIMPORTED (Imported aa) = case aa of
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder _ -> sep [ keyword givenS
9a6779c8495854bdf36e4a87f98f095e8d0a6e45Christian Maeder , sepByCommas $ map printGroupSpec aa]
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maederinstance Pretty FIT_ARG where
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder pretty = printFIT_ARG
656f17ae9b7610ff2de1b6eedeeadea0c3bcdc8dChristian MaederprintFIT_ARG :: FIT_ARG -> Doc
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian MaederprintFIT_ARG fit = case fit of
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder Fit_spec aa ab _ ->
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder let aa' = rmTopKey $ pretty aa
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder in if null ab then aa' else
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder fsep $ aa' : keyword fitS
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder : punctuate comma (map printG_mapping ab)
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder Fit_view si ab _ ->
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder sep [keyword viewS, cat [structSimpleId si, print_fit_arg_list ab]]
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maederinstance Pretty Logic_code where
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder pretty = printLogic_code
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian MaederprintLogic_code :: Logic_code -> Doc
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian MaederprintLogic_code (Logic_code menc msrc mtar _) =
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder let pm = maybe [] ((: []) . printLogic_name) in
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder fsep $ maybe [] ((: [colon]) . pretty) menc
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder ++ pm msrc ++ funArrow : pm mtar
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederinstance Pretty Logic_name where
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder pretty = printLogic_name
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian MaederprintLogic_name :: Logic_name -> Doc
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederprintLogic_name (Logic_name mlog slog) = let d = pretty mlog in
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder Just sub -> d <> dot <> pretty sub
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder-----------------------------------------------
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder specealized printing of 'FIT_ARG's
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederprint_fit_arg_list :: [Annoted FIT_ARG] -> Doc
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maederprint_fit_arg_list = cat . map (brackets . pretty)
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski conditional generation of grouping braces for Union and Extension
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill MossakowskiprintGroupSpec :: Annoted SPEC -> Doc
4e14c1bc2b97679b84c6ad996fa11c273b74ea02Christian MaederprintGroupSpec s = let d = pretty s in
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski case skip_Group $ item s of
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder Spec_inst _ _ _ -> d
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder _ -> specBraces d
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder generate grouping braces for Tanslations and Reductions
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian MaedercondBracesTransReduct :: Annoted SPEC -> Doc
4601edb679f0ba530bbb085b25d82a411cd070aaChristian MaedercondBracesTransReduct s = let d = pretty s in
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder case skip_Group $ item s of
26d11a256b1433604a3dbc69913b520fff7586acChristian Maeder Extension _ _ -> specBraces d
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder Union _ _ -> specBraces d
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder Local_spec _ _ _ -> specBraces d
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder generate grouping braces for Within
b5056cf24da461ee868c4be7b803a76b677fa21dChristian MaedercondBracesWithin :: Annoted SPEC -> Doc
b5056cf24da461ee868c4be7b803a76b677fa21dChristian MaedercondBracesWithin s = let d = pretty s in
b5056cf24da461ee868c4be7b803a76b677fa21dChristian Maeder case skip_Group $ item s of
b5056cf24da461ee868c4be7b803a76b677fa21dChristian Maeder Extension _ _ -> specBraces d
b5056cf24da461ee868c4be7b803a76b677fa21dChristian Maeder Union _ _ -> specBraces d
b5056cf24da461ee868c4be7b803a76b677fa21dChristian Maeder only Extensions inside of Unions (and) need grouping braces
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian MaedercondBracesAnd :: Annoted SPEC -> Doc
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedercondBracesAnd s = let d = pretty s in
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder case skip_Group $ item s of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder Extension _ _ -> specBraces d
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder-- | only skip groups without annotations
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederskipVoidGroup :: SPEC -> SPEC
aea143fff7a50aceb809845fbc42698b0b3f545aChristian MaederskipVoidGroup sp =
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder Group g _ | null (l_annos g) && null (r_annos g)
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder -> skipVoidGroup $ item g
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maeder-- | skip nested groups
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maederskip_Group :: SPEC -> SPEC
ef60398f3b9f24614b074f8f0f1349ab527e1c77Christian Maederskip_Group sp =
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz Group g _ -> skip_Group $ item g