{- | Module : ./Maude/Printing.hs Description : Translation from Haskell to Maude Copyright : (c) Martin Kuehl, Uni Bremen 2009 License : GPLv2 or higher, see LICENSE.txt Maintainer : mkhl@informatik.uni-bremen.de Stability : experimental Portability : portable Translations from Haskell to Maude. The translations from Haskell datatypes to Maude source code are implemented as instances of the typeclass 'Pretty' as defined in the modules "Common.Doc" and "Common.DocUtils", which see. Nothing else is exported by this module. -} module Maude.Printing () where import Maude.AS_Maude import Maude.Symbol import Common.Doc import Common.DocUtils (Pretty (..)) import Data.List (intersperse) -- * Combinators -- | Convert every item in @list@, combine with @dsep@, wrap with @wrap@. combine :: (Pretty a) => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine :: (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine _ _ [] = Doc empty combine wrap :: Doc -> Doc wrap dsep :: [Doc] -> Doc dsep list :: [a] list = Doc -> Doc wrap (Doc -> Doc) -> ([a] -> Doc) -> [a] -> Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc] -> Doc dsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Doc) -> [a] -> [Doc] forall a b. (a -> b) -> [a] -> [b] map a -> Doc forall a. Pretty a => a -> Doc pretty ([a] -> Doc) -> [a] -> Doc forall a b. (a -> b) -> a -> b $ [a] list -- | Separate with spaces, wrap with parentheses. parenPretties :: (Pretty a) => [a] -> Doc parenPretties :: [a] -> Doc parenPretties = (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc forall a. Pretty a => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine Doc -> Doc parens [Doc] -> Doc hsep -- | Separate with spaces, wrap with square brackets. bracketPretties :: (Pretty a) => [a] -> Doc bracketPretties :: [a] -> Doc bracketPretties = (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc forall a. Pretty a => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine Doc -> Doc brackets [Doc] -> Doc hsep -- | Separate with newlines, wrap with square brackets and newlines. combineHooks :: (Pretty a) => [a] -> Doc combineHooks :: [a] -> Doc combineHooks = let bracketed :: Doc -> Doc bracketed doc :: Doc doc = Doc lbrack Doc -> Doc -> Doc $+$ Doc doc Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Doc rbrack in (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc forall a. Pretty a => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine Doc -> Doc bracketed [Doc] -> Doc vcat {- | Assemble a pretty-printing for all parts of a Sentence, distinguishing conditional Sentence from simple ones. -} prettySentence :: (Pretty a, Pretty b) => String -> String -> Doc -> a -> b -> [Condition] -> [StmntAttr] -> Doc prettySentence :: String -> String -> Doc -> a -> b -> [Condition] -> [StmntAttr] -> Doc prettySentence s1 :: String s1 s2 :: String s2 op :: Doc op t1 :: a t1 t2 :: b t2 cs :: [Condition] cs as :: [StmntAttr] as = [Doc] -> Doc hsep ([Doc] -> Doc) -> [Doc] -> Doc forall a b. (a -> b) -> a -> b $ if [Condition] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Condition] cs then [String -> Doc keyword String s1, a -> Doc forall a. Pretty a => a -> Doc pretty a t1, Doc op, b -> Doc forall a. Pretty a => a -> Doc pretty b t2, [StmntAttr] -> Doc forall a. Pretty a => a -> Doc pretty [StmntAttr] as, Doc dot] else [String -> Doc keyword String s2, a -> Doc forall a. Pretty a => a -> Doc pretty a t1, Doc op, b -> Doc forall a. Pretty a => a -> Doc pretty b t2, [Condition] -> Doc forall a. Pretty a => a -> Doc pretty [Condition] cs, [StmntAttr] -> Doc forall a. Pretty a => a -> Doc pretty [StmntAttr] as, Doc dot] -- * Pretty instances -- ** Pretty Sentences instance Pretty Membership where pretty :: Membership -> Doc pretty (Mb t :: Term t s :: Sort s cs :: [Condition] cs as :: [StmntAttr] as) = String -> String -> Doc -> Term -> Sort -> [Condition] -> [StmntAttr] -> Doc forall a b. (Pretty a, Pretty b) => String -> String -> Doc -> a -> b -> [Condition] -> [StmntAttr] -> Doc prettySentence "mb" "cmb" Doc colon Term t Sort s [Condition] cs [StmntAttr] as instance Pretty Equation where pretty :: Equation -> Doc pretty (Eq t1 :: Term t1 t2 :: Term t2 cs :: [Condition] cs as :: [StmntAttr] as) = String -> String -> Doc -> Term -> Term -> [Condition] -> [StmntAttr] -> Doc forall a b. (Pretty a, Pretty b) => String -> String -> Doc -> a -> b -> [Condition] -> [StmntAttr] -> Doc prettySentence "eq" "ceq" Doc equals Term t1 Term t2 [Condition] cs [StmntAttr] as instance Pretty Rule where pretty :: Rule -> Doc pretty (Rl t1 :: Term t1 t2 :: Term t2 cs :: [Condition] cs as :: [StmntAttr] as) = String -> String -> Doc -> Term -> Term -> [Condition] -> [StmntAttr] -> Doc forall a b. (Pretty a, Pretty b) => String -> String -> Doc -> a -> b -> [Condition] -> [StmntAttr] -> Doc prettySentence "rl" "crl" Doc implies Term t1 Term t2 [Condition] cs [StmntAttr] as -- ** Pretty Conditions instance Pretty Condition where pretty :: Condition -> Doc pretty cond :: Condition cond = let pretty' :: a -> Doc -> a -> Doc pretty' x :: a x y :: Doc y z :: a z = [Doc] -> Doc hsep [a -> Doc forall a. Pretty a => a -> Doc pretty a x, Doc y, a -> Doc forall a. Pretty a => a -> Doc pretty a z] in case Condition cond of MbCond t :: Term t s :: Sort s -> Term -> Doc -> Sort -> Doc forall a a. (Pretty a, Pretty a) => a -> Doc -> a -> Doc pretty' Term t Doc colon Sort s EqCond t1 :: Term t1 t2 :: Term t2 -> Term -> Doc -> Term -> Doc forall a a. (Pretty a, Pretty a) => a -> Doc -> a -> Doc pretty' Term t1 Doc equals Term t2 RwCond t1 :: Term t1 t2 :: Term t2 -> Term -> Doc -> Term -> Doc forall a a. (Pretty a, Pretty a) => a -> Doc -> a -> Doc pretty' Term t1 Doc implies Term t2 MatchCond t1 :: Term t1 t2 :: Term t2 -> Term -> Doc -> Term -> Doc forall a a. (Pretty a, Pretty a) => a -> Doc -> a -> Doc pretty' Term t1 (String -> Doc text ":=") Term t2 pretties :: [Condition] -> Doc pretties = (Doc -> Doc) -> ([Doc] -> Doc) -> [Condition] -> Doc forall a. Pretty a => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine (String -> Doc text "if" Doc -> Doc -> Doc <+>) ([Doc] -> Doc hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . Doc -> [Doc] -> [Doc] forall a. a -> [a] -> [a] intersperse Doc andDoc) -- ** Pretty Attributes instance Pretty Attr where pretty :: Attr -> Doc pretty attr :: Attr attr = case Attr attr of Assoc -> String -> Doc text "assoc" Comm -> String -> Doc text "comm" Idem -> String -> Doc text "idem" Iter -> String -> Doc text "iter" Id term :: Term term -> String -> Doc text "id:" Doc -> Doc -> Doc <+> Term -> Doc forall a. Pretty a => a -> Doc pretty Term term LeftId term :: Term term -> String -> Doc text "id-left:" Doc -> Doc -> Doc <+> Term -> Doc forall a. Pretty a => a -> Doc pretty Term term RightId term :: Term term -> String -> Doc text "id-right:" Doc -> Doc -> Doc <+> Term -> Doc forall a. Pretty a => a -> Doc pretty Term term Strat ints :: [Int] ints -> String -> Doc text "strat" Doc -> Doc -> Doc <+> [Int] -> Doc forall a. Pretty a => [a] -> Doc parenPretties [Int] ints Memo -> String -> Doc text "memo" Prec int :: Int int -> String -> Doc text "prec" Doc -> Doc -> Doc <+> Int -> Doc forall a. Pretty a => a -> Doc pretty Int int Gather qids :: [Qid] qids -> String -> Doc text "gather" Doc -> Doc -> Doc <+> [Qid] -> Doc forall a. Pretty a => [a] -> Doc parenPretties [Qid] qids Format qids :: [Qid] qids -> String -> Doc text "format" Doc -> Doc -> Doc <+> [Qid] -> Doc forall a. Pretty a => [a] -> Doc parenPretties [Qid] qids Ctor -> String -> Doc text "ctor" Config -> String -> Doc text "config" Object -> String -> Doc text "object" Msg -> String -> Doc text "msg" Frozen ints :: [Int] ints -> String -> Doc text "frozen" Doc -> Doc -> Doc <+> [Int] -> Doc forall a. Pretty a => [a] -> Doc parenPretties [Int] ints Poly ints :: [Int] ints -> String -> Doc text "poly" Doc -> Doc -> Doc <+> [Int] -> Doc forall a. Pretty a => [a] -> Doc parenPretties [Int] ints Special hooks :: [Hook] hooks -> String -> Doc text "special" Doc -> Doc -> Doc <+> [Hook] -> Doc forall a. Pretty a => [a] -> Doc combineHooks [Hook] hooks pretties :: [Attr] -> Doc pretties = [Attr] -> Doc forall a. Pretty a => [a] -> Doc bracketPretties instance Pretty StmntAttr where pretty :: StmntAttr -> Doc pretty attr :: StmntAttr attr = case StmntAttr attr of Owise -> String -> Doc text "owise" Nonexec -> String -> Doc text "nonexec" Metadata str :: String str -> String -> Doc text "metadata" Doc -> Doc -> Doc <+> Doc -> Doc doubleQuotes (String -> Doc forall a. Pretty a => a -> Doc pretty String str) Label qid :: Qid qid -> String -> Doc text "label" Doc -> Doc -> Doc <+> Doc -> Doc doubleQuotes (Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid) Print _ -> Doc empty pretties :: [StmntAttr] -> Doc pretties = [StmntAttr] -> Doc forall a. Pretty a => [a] -> Doc bracketPretties -- ** Pretty Hooks instance Pretty Hook where pretty :: Hook -> Doc pretty hook :: Hook hook = case Hook hook of IdHook qid :: Qid qid qs :: [Qid] qs -> [Doc] -> Doc hsep [String -> Doc text "id-hook", Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid, [Qid] -> Doc forall a. Pretty a => [a] -> Doc parenPretties [Qid] qs] OpHook qid :: Qid qid op :: Qid op dom :: [Qid] dom cod :: Qid cod -> let symb :: Symbol symb = Qid -> [Qid] -> Qid -> Symbol mkOpPartial Qid op [Qid] dom Qid cod in [Doc] -> Doc hsep [String -> Doc text "op-hook", Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid, Doc -> Doc parens (Doc -> Doc) -> Doc -> Doc forall a b. (a -> b) -> a -> b $ Symbol -> Doc forall a. Pretty a => a -> Doc pretty Symbol symb] TermHook qid :: Qid qid term :: Term term -> [Doc] -> Doc hsep [String -> Doc text "term-hook", Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid, Doc -> Doc parens (Doc -> Doc) -> Doc -> Doc forall a b. (a -> b) -> a -> b $ Term -> Doc forall a. Pretty a => a -> Doc pretty Term term] pretties :: [Hook] -> Doc pretties = (Doc -> Doc) -> ([Doc] -> Doc) -> [Hook] -> Doc forall a. Pretty a => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine Doc -> Doc parens [Doc] -> Doc vcat -- ** Pretty Terms instance Pretty Term where pretty :: Term -> Doc pretty term :: Term term = case Term term of Const qid :: Qid qid _ -> Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid Var qid :: Qid qid tp :: Type tp -> [Doc] -> Doc hcat [Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid, Doc colon, Type -> Doc forall a. Pretty a => a -> Doc pretty Type tp] Apply qid :: Qid qid ts :: [Term] ts _ -> Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> (Doc -> Doc parens (Doc -> Doc) -> ([Term] -> Doc) -> [Term] -> Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . [Term] -> Doc forall a. Pretty a => a -> Doc pretty ([Term] -> Doc) -> [Term] -> Doc forall a b. (a -> b) -> a -> b $ [Term] ts) pretties :: [Term] -> Doc pretties = (Doc -> Doc) -> ([Doc] -> Doc) -> [Term] -> Doc forall a. Pretty a => (Doc -> Doc) -> ([Doc] -> Doc) -> [a] -> Doc combine Doc -> Doc forall a. a -> a id [Doc] -> Doc sepByCommas -- ** Pretty Identifiers instance Pretty Type where pretty :: Type -> Doc pretty typ :: Type typ = case Type typ of TypeSort sort :: Sort sort -> Sort -> Doc forall a. Pretty a => a -> Doc pretty Sort sort TypeKind kind :: Kind kind -> Kind -> Doc forall a. Pretty a => a -> Doc pretty Kind kind instance Pretty Sort where pretty :: Sort -> Doc pretty (SortId qid :: Qid qid) = Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid instance Pretty Kind where pretty :: Kind -> Doc pretty (KindId qid :: Qid qid) = Doc -> Doc brackets (Doc -> Doc) -> Doc -> Doc forall a b. (a -> b) -> a -> b $ Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid instance Pretty ParamId where pretty :: ParamId -> Doc pretty (ParamId qid :: Qid qid) = Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid instance Pretty ViewId where pretty :: ViewId -> Doc pretty (ViewId qid :: Qid qid) = Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid instance Pretty ModId where pretty :: ModId -> Doc pretty (ModId qid :: Qid qid) = Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid instance Pretty LabelId where pretty :: LabelId -> Doc pretty (LabelId qid :: Qid qid) = Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid instance Pretty OpId where pretty :: OpId -> Doc pretty (OpId qid :: Qid qid) = Qid -> Doc forall a. Pretty a => a -> Doc pretty Qid qid