4751N/A{- |

4751N/AModule : ./Syntax/Print_AS_Architecture.hs

4751N/ADescription : pretty printing of CASL architectural specifications

4751N/ACopyright : (c) Klaus Luettich, Uni Bremen 2002-2006

4751N/ALicense : GPLv2 or higher, see LICENSE.txt

4751N/AMaintainer : Christian.Maeder@dfki.de

4751N/AStability : provisional

4751N/APortability : non-portable(Grothendieck)

4751N/A

4751N/APretty printing of CASL architectural specifications

4751N/A-}

4751N/A

4751N/Amodule Syntax.Print_AS_Architecture () where

4751N/A

4751N/Aimport Common.Doc

4751N/Aimport Common.DocUtils

4751N/Aimport Common.Keywords

4751N/A

4751N/Aimport Syntax.AS_Architecture

4751N/Aimport Syntax.Print_AS_Structured

4751N/A

4751N/Asp1 :: Doc

4751N/Asp1 = keyword " "

4751N/A

4751N/Ainstance PrettyLG ARCH_SPEC where

5061N/A prettyLG lg a = case a of

4751N/A Basic_arch_spec aa ab _ -> sep [keyword (unitS ++ sS)

4751N/A <+> vcat (punctuate semi $ map (prettyLG lg) aa)

4751N/A , keyword resultS <+> prettyLG lg ab]

4751N/A Arch_spec_name aa -> pretty aa

4751N/A Group_arch_spec aa _ -> specBraces . rmTopKey $ prettyLG lg aa

4751N/A

4751N/Ainstance PrettyLG UNIT_REF where

4751N/A prettyLG lg (Unit_ref aa ab _) =

4751N/A fsep [structIRI aa, keyword toS, prettyLG lg ab]

4751N/A

4751N/Ainstance PrettyLG UNIT_DECL_DEFN where

4751N/A prettyLG lg ud = case ud of

4751N/A Unit_decl aa ab ac _ -> cat [structIRI aa <+> colon,

4751N/A sp1 <> fsep (prettyLG lg ab :

4751N/A if null ac then [] else

4751N/A keyword givenS : punctuate comma (map (prettyLG lg) ac))]

4751N/A Unit_defn aa ab _ ->

4751N/A cat [structIRI aa <+> equals, sp1 <> prettyLG lg ab]

4751N/A

4751N/Ainstance PrettyLG UNIT_SPEC where

4751N/A prettyLG lg u = case u of

4751N/A Unit_type aa ab _ ->

4751N/A let ab' = rmTopKey $ printGroupSpec lg ab

4751N/A in if null aa then ab' else sep

4751N/A [ fsep . punctuate (space <> cross)

4751N/A $ map (rmTopKey . printGroupSpec lg) aa

4751N/A , funArrow <+> ab']

4751N/A Spec_name aa -> pretty aa

4751N/A Closed_unit_spec aa _ -> fsep [keyword closedS, prettyLG lg aa]

4751N/A

4751N/Ainstance PrettyLG REF_SPEC where

4751N/A prettyLG lg rs = case rs of

4751N/A Unit_spec u -> prettyLG lg u

4751N/A Refinement b u m r _ -> fsep $

4751N/A prettyLG lg u : (if b then [] else [keyword behaviourallyS])

4751N/A ++ [keyword refinedS]

4751N/A ++ (if null m then [] else keyword viaS :

4751N/A punctuate comma (map pretty m))

4751N/A ++ [keyword toS, prettyLG lg r]

4751N/A Arch_unit_spec aa _ ->

4751N/A fsep [keyword archS <+> keyword specS, prettyLG lg aa]

4751N/A Compose_ref aa _ -> case aa of

4751N/A [] -> empty

4751N/A x : xs -> sep $ prettyLG lg x :

4751N/A map ( \ s -> keyword thenS <+> prettyLG lg s) xs

4751N/A Component_ref aa _ ->

4751N/A specBraces $ sepByCommas $ map (prettyLG lg) aa

4751N/A

4751N/Ainstance PrettyLG UNIT_EXPRESSION where

4751N/A prettyLG lg (Unit_expression aa ab _) =

4751N/A let ab' = prettyLG lg ab

4751N/A in if null aa then ab'

4751N/A else fsep $ keyword lambdaS :

4751N/A punctuate semi (map (prettyLG lg) aa)

4751N/A ++ [addBullet ab']

4751N/A

4751N/Ainstance PrettyLG UNIT_BINDING where

4751N/A prettyLG lg (Unit_binding aa ab _) =

4751N/A let aa' = structIRI aa

4751N/A ab' = prettyLG lg ab

4751N/A in fsep [aa', colon, ab']

4751N/A

4751N/Ainstance PrettyLG UNIT_TERM where

4751N/A prettyLG lg ut = case ut of

4751N/A Unit_reduction aa ab ->

4751N/A let aa' = prettyLG lg aa

4751N/A ab' = pretty ab

4751N/A in fsep [aa', ab']

4751N/A Unit_translation aa ab ->

4751N/A let aa' = prettyLG lg aa

4751N/A ab' = pretty ab

4751N/A in fsep [aa', ab']

4751N/A Amalgamation aa _ -> case aa of

4751N/A [] -> empty

4751N/A x : xs -> sep $ prettyLG lg x :

4751N/A map ( \ s -> keyword andS <+> prettyLG lg s) xs

4751N/A Local_unit aa ab _ ->

4751N/A fsep $ keyword localS : punctuate semi (map (prettyLG lg) aa)

4751N/A ++ [keyword withinS, prettyLG lg ab]

4751N/A Unit_appl aa ab _ -> fsep $ structIRI aa : map (prettyLG lg) ab

4751N/A Group_unit_term aa _ -> specBraces $ prettyLG lg aa

4751N/A

4751N/Ainstance PrettyLG FIT_ARG_UNIT where

4751N/A prettyLG lg (Fit_arg_unit aa ab _) = brackets $

4751N/A fsep $ prettyLG lg aa : if null ab then []

4751N/A else keyword fitS : punctuate comma (map pretty ab)

4751N/A