c0202e5a338212ae386c672821f6dc4931c50f45James PhillpottsDescription : pretty printing of CASL architectural specifications
c0202e5a338212ae386c672821f6dc4931c50f45James PhillpottsCopyright : (c) Klaus Luettich, Uni Bremen 2002-2006
457109fb66ae45236beb93b458603bff012e6d14Phill CunningtonLicense : GPLv2 or higher, see LICENSE.txt
c0202e5a338212ae386c672821f6dc4931c50f45James PhillpottsMaintainer : Christian.Maeder@dfki.de
c0202e5a338212ae386c672821f6dc4931c50f45James PhillpottsStability : provisional
c0202e5a338212ae386c672821f6dc4931c50f45James PhillpottsPortability : non-portable(Grothendieck)
c0202e5a338212ae386c672821f6dc4931c50f45James PhillpottsPretty printing of CASL architectural specifications
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsmodule Syntax.Print_AS_Architecture () where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottssp1 = keyword " "
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG ARCH_SPEC where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg a = case a of
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Basic_arch_spec aa ab _ -> sep [keyword (unitS ++ sS)
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts <+> vcat (punctuate semi $ map (prettyLG lg) aa)
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts , keyword resultS <+> prettyLG lg ab]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Arch_spec_name aa -> pretty aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Group_arch_spec aa _ -> specBraces . rmTopKey $ prettyLG lg aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG UNIT_REF where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg (Unit_ref aa ab _) =
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts fsep [structIRI aa, keyword toS, prettyLG lg ab]
685810e390056c123842842f5104daa3179cf2c9Phill Cunningtoninstance PrettyLG UNIT_DECL_DEFN where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg ud = case ud of
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Unit_decl aa ab ac _ -> cat [structIRI aa <+> colon,
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts sp1 <> fsep (prettyLG lg ab :
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts if null ac then [] else
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts keyword givenS : punctuate comma (map (prettyLG lg) ac))]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Unit_defn aa ab _ ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts cat [structIRI aa <+> equals, sp1 <> prettyLG lg ab]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG UNIT_SPEC where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg u = case u of
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Unit_type aa ab _ ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts let ab' = rmTopKey $ printGroupSpec lg ab
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts in if null aa then ab' else sep
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts [ fsep . punctuate (space <> cross)
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts $ map (rmTopKey . printGroupSpec lg) aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts , funArrow <+> ab']
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Spec_name aa -> pretty aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Closed_unit_spec aa _ -> fsep [keyword closedS, prettyLG lg aa]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG REF_SPEC where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg rs = case rs of
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Unit_spec u -> prettyLG lg u
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Refinement b u m r _ -> fsep $
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg u : (if b then [] else [keyword behaviourallyS])
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ++ [keyword refinedS]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ++ (if null m then [] else keyword viaS :
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts punctuate comma (map pretty m))
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ++ [keyword toS, prettyLG lg r]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Arch_unit_spec aa _ ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts fsep [keyword archS <+> keyword specS, prettyLG lg aa]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Compose_ref aa _ -> case aa of
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts x : xs -> sep $ prettyLG lg x :
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts map ( \ s -> keyword thenS <+> prettyLG lg s) xs
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Component_ref aa _ ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts specBraces $ sepByCommas $ map (prettyLG lg) aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG UNIT_EXPRESSION where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg (Unit_expression aa ab _) =
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts let ab' = prettyLG lg ab
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts in if null aa then ab'
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts else fsep $ keyword lambdaS :
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts punctuate semi (map (prettyLG lg) aa)
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ++ [addBullet ab']
685810e390056c123842842f5104daa3179cf2c9Phill Cunningtoninstance PrettyLG UNIT_BINDING where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg (Unit_binding aa ab _) =
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts let aa' = structIRI aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ab' = prettyLG lg ab
685810e390056c123842842f5104daa3179cf2c9Phill Cunnington in fsep [aa', colon, ab']
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG UNIT_TERM where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg ut = case ut of
685810e390056c123842842f5104daa3179cf2c9Phill Cunnington Unit_reduction aa ab ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts let aa' = prettyLG lg aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ab' = pretty ab
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts in fsep [aa', ab']
685810e390056c123842842f5104daa3179cf2c9Phill Cunnington Unit_translation aa ab ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts let aa' = prettyLG lg aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ab' = pretty ab
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts in fsep [aa', ab']
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Amalgamation aa _ -> case aa of
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts x : xs -> sep $ prettyLG lg x :
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts map ( \ s -> keyword andS <+> prettyLG lg s) xs
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Local_unit aa ab _ ->
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts fsep $ keyword localS : punctuate semi (map (prettyLG lg) aa)
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts ++ [keyword withinS, prettyLG lg ab]
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Unit_appl aa ab _ -> fsep $ structIRI aa : map (prettyLG lg) ab
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts Group_unit_term aa _ -> specBraces $ prettyLG lg aa
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpottsinstance PrettyLG FIT_ARG_UNIT where
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts prettyLG lg (Fit_arg_unit aa ab _) = brackets $
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts fsep $ prettyLG lg aa : if null ab then []
c0202e5a338212ae386c672821f6dc4931c50f45James Phillpotts else keyword fitS : punctuate comma (map pretty ab)