{- |
Module      :  ./COL/Print_AS.hs
Description :  Pretty printing for COL
Copyright   :  (c) Wiebke Herding, C. Maeder, Uni Bremen 2004-2006
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  till@informatik.uni-bremen.de
Stability   :  provisional
Portability :  portable

pretty printing
-}

module COL.Print_AS where

import qualified Data.Set as Set
import qualified Data.Map as Map
import Common.Doc
import Common.DocUtils
import CASL.ToDoc
import COL.AS_COL
import COL.COLSign

instance Pretty COL_SIG_ITEM where
    pretty :: COL_SIG_ITEM -> Doc
pretty = COL_SIG_ITEM -> Doc
printCOL_SIG_ITEM

printCOL_SIG_ITEM :: COL_SIG_ITEM -> Doc
printCOL_SIG_ITEM :: COL_SIG_ITEM -> Doc
printCOL_SIG_ITEM csi :: COL_SIG_ITEM
csi = case COL_SIG_ITEM
csi of
    Constructor_items ls :: [Annoted Id]
ls _ -> String -> Doc
keyword (String
constructorS String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Annoted Id] -> String
forall a. ListCheck a => a -> String
pluralS [Annoted Id]
ls) Doc -> Doc -> Doc
<+>
        (Id -> Doc) -> [Annoted Id] -> Doc
forall a. (a -> Doc) -> [Annoted a] -> Doc
semiAnnos Id -> Doc
idDoc [Annoted Id]
ls
    Observer_items ls :: [Annoted (Id, Maybe Int)]
ls _ -> String -> Doc
keyword String
observerS Doc -> Doc -> Doc
<+>
        ((Id, Maybe Int) -> Doc) -> [Annoted (Id, Maybe Int)] -> Doc
forall a. (a -> Doc) -> [Annoted a] -> Doc
semiAnnos ((Id -> Doc) -> (Maybe Int -> Doc) -> (Id, Maybe Int) -> Doc
forall a b. (a -> Doc) -> (b -> Doc) -> (a, b) -> Doc
printPair Id -> Doc
idDoc ((Int -> Doc) -> Maybe Int -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
printMaybe Int -> Doc
forall a. Pretty a => a -> Doc
pretty)) [Annoted (Id, Maybe Int)]
ls

instance Pretty COLSign where
    pretty :: COLSign -> Doc
pretty = COLSign -> Doc
printCOLSign

printCOLSign :: COLSign -> Doc
printCOLSign :: COLSign -> Doc
printCOLSign s :: COLSign
s = String -> Doc
keyword String
constructorS Doc -> Doc -> Doc
<+>
    [Doc] -> Doc
fsep (Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
idDoc (Set Id -> [Id]
forall a. Set a -> [a]
Set.toList (Set Id -> [Id]) -> Set Id -> [Id]
forall a b. (a -> b) -> a -> b
$ COLSign -> Set Id
constructors COLSign
s))
    Doc -> Doc -> Doc
$+$ String -> Doc
keyword String
observerS Doc -> Doc -> Doc
<+>
    [Doc] -> Doc
fsep (Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
      ((Id, Int) -> Doc) -> [(Id, Int)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Id -> Doc) -> (Int -> Doc) -> (Id, Int) -> Doc
forall a b. (a -> Doc) -> (b -> Doc) -> (a, b) -> Doc
printPair Id -> Doc
idDoc Int -> Doc
forall a. Pretty a => a -> Doc
pretty) (Map Id Int -> [(Id, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Id Int -> [(Id, Int)]) -> Map Id Int -> [(Id, Int)]
forall a b. (a -> b) -> a -> b
$ COLSign -> Map Id Int
observers COLSign
s))