f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzDescription : Printer for abstract syntax of CSL
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzCopyright : (c) Dominik Dietrich, Ewaryst Schulz, DFKI Bremen 2010
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzLicense : GPLv2 or higher, see LICENSE.txt
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzMaintainer : Ewaryst.Schulz@dfki.de
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzStability : experimental
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzPortability : portable
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzPretty printing the abstract syntax of CSL.
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz ( printExpression
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz , printAssDefinition
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz , printConstantName
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz , ExpressionPrinter (..)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzimport Numeric
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz-- * Pretty Printing
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst Schulzinstance Pretty InfInt where
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst Schulz pretty = printInfInt
3d52aec7d9849d727bc457cd76ac93b3f523c629Ewaryst Schulzinstance Pretty GroundConstant where
3d52aec7d9849d727bc457cd76ac93b3f523c629Ewaryst Schulz pretty = printGC
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst Schulzinstance (Ord a, Pretty a) => Pretty (SetOrInterval a) where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printDomain
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulzinstance Pretty a => Pretty (ClosedInterval a) where
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty = printClosedInterval
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulzinstance Pretty OpDecl where
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty = head . printOpDecl
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulzinstance Pretty VarDecl where
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty = printVarDecl
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulzinstance Pretty EPVal where
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty = printEPVal
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulzinstance Pretty EPDecl where
1a3c23972e61ef722a650eae2c6312a0dbe8f185Ewaryst Schulz pretty = printEPDecl
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty OP_ITEM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printOpItem
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty VAR_ITEM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printVarItem
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty BASIC_SPEC where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printBasicSpec
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty BASIC_ITEM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printBasicItems
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty EXTPARAM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printExtparam
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty EXPRESSION where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = head . printExpression
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty SYMB_ITEMS where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printSymbItems
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty SYMB where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printSymbol
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty SYMB_MAP_ITEMS where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printSymbMapItems
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty SYMB_OR_MAP where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printSymbOrMap
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty CMD where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = head . printCMD
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty ConstantName where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = printConstantName
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty AssDefinition where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = head . printAssDefinition
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty OPID where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty = head . printOPID
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- | A monad for printing of constants. This turns the pretty printing facility
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroedermore flexible w.r.t. the output of 'ConstantName'. -}
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzclass Monad m => ExpressionPrinter m where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getOINM :: m OpInfoNameMap
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getOINM = return operatorInfoNameMap
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printConstant :: ConstantName -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printConstant = return . printConstantName
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printOpname :: OPNAME -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printOpname = return . text . showOPNAME
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz prefixMode :: m Bool
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz prefixMode = return False
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printArgs :: [Doc] -> m Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder printArgs = return . parens . sepByCommas
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz printArgPattern :: String -> m Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder printArgPattern = return . text
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printInterval :: Double -> Double -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printInterval l r =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz return $ brackets $ sepByCommas $ map (text . show) [l, r]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz printRational :: APFloat -> m Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder printRational r = return $ text $ showFloat (fromRat r :: Double) ""
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz-- | The default ConstantName printer
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintConstantName :: ConstantName -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintConstantName (SimpleConstant s) = text s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintConstantName (ElimConstant s i) =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz text $ if i > 0 then s ++ "__" ++ show i else s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintAssDefinition :: ExpressionPrinter m => AssDefinition -> m Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintAssDefinition (ConstDef e) = liftM (text "=" <+>) $ printExpression e
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintAssDefinition (FunDef l e) = do
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz ed <- printExpression e
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz l' <- mapM printArgPattern l
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz args <- printArgs l'
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz return $ args <+> text "=" <+> ed
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintOPID :: ExpressionPrinter m => OPID -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintOPID (OpUser c) = printConstant c
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintOPID (OpId oi) = printOpname oi
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz-- a dummy instance, we take the simplest monad
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance ExpressionPrinter []
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz-- | An 'OpInfoNameMap' can be interpreted as an 'ExpressionPrinter'
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance ExpressionPrinter (Reader OpInfoNameMap) where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getOINM = ask
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCMD :: ExpressionPrinter m => CMD -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCMD (Ass c def) = do
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz def' <- printExpression def
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz c' <- printOpDecl c
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz return $ c' <+> text ":=" <+> def'
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCMD c@(Cmd s exps) -- TODO: remove the case := later
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | s == ":=" = error $ "printCMD: use Ass for assignment representation! "
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder | s == "constraint" = printExpression (head exps)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | otherwise = let f l = text s <> parens (sepByCommas l)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz in liftM f $ mapM printExpression exps
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCMD (Repeat e stms) = do
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz e' <- printExpression e
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz let f l = text "re" <>
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (text "peat" $+$ vcat (map (text "." <+>) l))
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz $+$ text "until" <+> e'
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz liftM f $ mapM printCMD stms
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCMD (Sequence stms) =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz let f l = text "se" <> (text "quence" $+$ vcat (map (text "." <+>) l))
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz $+$ text "end"
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz in liftM f $ mapM printCMD stms
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCMD (Cond l) = let f l' = vcat l' $+$ text "end"
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz in liftM f $ mapM (uncurry printCase) l
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCase :: ExpressionPrinter m => EXPRESSION -> [CMD] -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintCase e l = do
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz e' <- printExpression e
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz let f l' = text "ca" <> (text "se" <+> e' <> text ":"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder $+$ vcat (map (text "." <+>) l'))
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz liftM f $ mapM printCMD l
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetPrec :: OpInfoNameMap -> EXPRESSION -> Int
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetPrec oinm (Op s _ exps _)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder | null exps = maxPrecedence + 1
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | otherwise =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz case lookupOpInfo oinm s $ length exps of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Right oi -> prec oi
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Left True -> error $
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz concat [ "getPrec: registered operator ", show s, " used "
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz , "with non-registered arity ", show $ length exps ]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> maxPrecedence {- this is probably a user-defined prefix function
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder , binds strongly -}
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetPrec _ _ = maxPrecedence
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetOp :: EXPRESSION -> Maybe OPID
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetOp (Op s _ _ _) = Just s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetOp _ = Nothing
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExtparam :: EXTPARAM -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExtparam (EP p op i) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty p <> text op <> (if op == "-|" then empty else text $ show i)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExtparams :: [EXTPARAM] -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExtparams [] = empty
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExtparams l = brackets $ sepByCommas $ map printExtparam l
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintInfix :: ExpressionPrinter m => EXPRESSION -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintInfix e@(Op s _ exps@[e1, e2] _) = do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- we mustn't omit the space between the operator and its arguments for text-
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederoperators such as "and", "or", but it would be good to omit it for "+-*/" -}
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz oi <- printOPID s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz oinm <- getOINM
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz let outerprec = getPrec oinm e
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz f cmp e' ed = if cmp outerprec $ getPrec oinm e' then ed else parens ed
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz g [ed1, ed2] = let cmp = case getOp e1 of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Just op1 | op1 == s -> (<=)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | otherwise -> (<)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder in sep [f cmp e1 ed1, oi <+> f (<) e2 ed2]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz g _ = error "printInfix: Inner impossible case"
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz liftM g $ mapM printExpression exps
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintInfix _ = error "printInfix: Impossible case"
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression :: ExpressionPrinter m => EXPRESSION -> m Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression (Var token) = return $ text $ tokStr token
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression e@(Op s epl exps _)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder | null exps = liftM (<> printExtparams epl) $ printOPID s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | otherwise = do
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz let asPrfx pexps = do
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz oid <- printOPID s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz args <- printArgs pexps
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz return $ oid <> printExtparams epl <> args
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz asPrfx' = mapM printExpression exps >>= asPrfx
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz oinm <- getOINM
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pfxMode <- prefixMode
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz if pfxMode then asPrfx' else
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder case lookupOpInfo oinm s $ length exps of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | infx oi -> printInfix e
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz | otherwise -> asPrfx'
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression (List exps _) = liftM sepByCommas (mapM printExpression exps)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression (Int i _) = return $ text (show i)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression (Rat r _) = printRational r
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintExpression (Interval l r _) = printInterval l r
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintOpItem :: OP_ITEM -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintOpItem (Op_item tokens _) =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz text "operator" <+> sepByCommas (map pretty tokens)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintVarItem :: VAR_ITEM -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintVarItem (Var_item vars dom _) =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz hsep [sepByCommas $ map pretty vars, text "in", pretty dom]
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulzinstance Pretty Ordering where
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty LT = text "<"
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty GT = text ">"
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz pretty EQ = text "="
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintVarDecl :: VarDecl -> Doc
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintVarDecl (VarDecl n (Just dom)) = pretty n <+> text "in" <+> printDomain dom
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintVarDecl (VarDecl n Nothing) = pretty n
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintOpDecl :: ExpressionPrinter m => OpDecl -> m Doc
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintOpDecl (OpDecl n epl vdl _)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder | null vdl = liftM (<> printExtparams epl) $ printConstant n
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz | otherwise = do
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz oid <- printConstant n
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz args <- printArgs $ map printVarDecl vdl
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz return $ oid <> printExtparams epl <> args
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintEPVal :: EPVal -> Doc
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintEPVal (EPVal i) = pretty i
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintEPVal (EPConstRef r) = pretty r
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintEPDecl :: EPDecl -> Doc
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintEPDecl (EPDecl tk dom mDef) =
1a3c23972e61ef722a650eae2c6312a0dbe8f185Ewaryst Schulz let tkD = pretty tk
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz domD = printInfixWith True "in" (tk, dom)
1a3c23972e61ef722a650eae2c6312a0dbe8f185Ewaryst Schulz in case mDef of
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz Just def -> vcat [domD, hsep [ text "set", text "default"
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz , hcat [tkD, text "=", pretty def]]]
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintClosedInterval :: Pretty a => ClosedInterval a -> Doc
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst SchulzprintClosedInterval (ClosedInterval l r) =
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz hcat [ lbrack, sepByCommas $ map pretty [l, r], rbrack ]
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst SchulzprintDomain :: (Ord a, Pretty a) => SetOrInterval a -> Doc
3d52aec7d9849d727bc457cd76ac93b3f523c629Ewaryst SchulzprintDomain (Set s) = pretty s
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintDomain (IntVal (c1, b1) (c2, b2)) =
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst Schulz hcat [ getIBorder True b1, sepByCommas $ map pretty [c1, c2]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz , getIBorder False b2]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetIBorder :: Bool -> Bool -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetIBorder False False = lbrack
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetIBorder True True = lbrack
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzgetIBorder _ _ = rbrack
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintGC :: GroundConstant -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintGC (GCI i) = text (show i)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintGC (GCR d) = text (show d)
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst SchulzprintInfInt :: InfInt -> Doc
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst SchulzprintInfInt NegInf = text "-oo"
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst SchulzprintInfInt PosInf = text "oo"
f8adc2a1376cd0946ec912a7f468cc05059a46dcEwaryst SchulzprintInfInt (FinInt x) = text $ show x
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintBasicSpec :: BASIC_SPEC -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintBasicSpec (Basic_spec xs) = vcat $ map pretty xs
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintBasicItems :: BASIC_ITEM -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintBasicItems (Axiom_item x) = pretty x
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintBasicItems (Op_decl x) = pretty x
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBasicItems (Var_decls x) = text "vars" <+> sepBySemis (map pretty x)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBasicItems (EP_decl x) = text "eps" <+> sepBySemis
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (map (printInfixWith True "in") x)
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintBasicItems (EP_domdecl x) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder text "set" <+> sepBySemis (map (printInfixWith False "=") x)
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintBasicItems (EP_defval x) = text "set" <+> text "default" <+>
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder sepBySemis (map (printInfixWith False "=") x)
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintInfixWith :: (Pretty a, Pretty b) => Bool -> String -> (a, b) -> Doc
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst SchulzprintInfixWith b s (x, y) = sep' [pretty x, text s, pretty y]
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz where sep' = if b then hsep else hcat
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbol :: SYMB -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbol (Symb_id sym) = pretty sym
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbItems :: SYMB_ITEMS -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbItems (Symb_items xs _) = fsep $ map pretty xs
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbOrMap :: SYMB_OR_MAP -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbOrMap (Symb sym) = pretty sym
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbOrMap (Symb_map source dest _) =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty source <+> mapsto <+> pretty dest
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbMapItems :: SYMB_MAP_ITEMS -> Doc
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst SchulzprintSymbMapItems (Symb_map_items xs _) = fsep $ map pretty xs
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz-- Instances for GetRange
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange OP_ITEM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan x = case x of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Op_item a b -> joinRanges [rangeSpan a, rangeSpan b]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange VAR_ITEM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan x = case x of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Var_item a _ b -> joinRanges [rangeSpan a, rangeSpan b]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange BASIC_SPEC where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan x = case x of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Basic_spec a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange BASIC_ITEM where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan x = case x of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Op_decl a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Var_decls a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Axiom_item a -> joinRanges [rangeSpan a]
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz EP_decl a -> joinRanges [rangeSpan $ map fst a]
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz EP_domdecl a -> joinRanges [rangeSpan $ map fst a]
e40c19038803d4a3d8914f5310a0ae8f4e683c3cEwaryst Schulz EP_defval a -> joinRanges [rangeSpan $ map fst a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange CMD where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
76408af596b604997cabe1ebde1caaa43f58b1e6Ewaryst Schulz rangeSpan (Ass _ def) = rangeSpan def
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Cmd _ exps) = joinRanges (map rangeSpan exps)
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz -- parsing guruantees l <> null
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Repeat c l) = joinRanges [rangeSpan c, rangeSpan $ head l]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz -- parsing guruantees l <> null
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Sequence l) = rangeSpan $ head l
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Cond l) = rangeSpan $ head l
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange SYMB_ITEMS where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Symb_items a b) = joinRanges [rangeSpan a, rangeSpan b]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange SYMB where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Symb_id a) = joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange SYMB_MAP_ITEMS where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan (Symb_map_items a b) = joinRanges [rangeSpan a, rangeSpan b]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange SYMB_OR_MAP where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan x = case x of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Symb a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Symb_map a b c -> joinRanges [rangeSpan a, rangeSpan b, rangeSpan c]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance GetRange EXPRESSION where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz getRange = Range . rangeSpan
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz rangeSpan x = case x of
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Var token -> joinRanges [rangeSpan token]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Op _ _ exps a -> joinRanges $ rangeSpan a : map rangeSpan exps
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder List exps a -> joinRanges $ rangeSpan a : map rangeSpan exps
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Int _ a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Rat _ a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz Interval _ _ a -> joinRanges [rangeSpan a]
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulzinstance Pretty InstantiatedConstant where
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz pretty (InstantiatedConstant { constName = cn, instantiation = el }) =
f6a120017bc91a7644e258bc4fdc21f5f16b2601Ewaryst Schulz if null el then pretty cn
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder else pretty cn <> parens (sepByCommas $ map pretty el)