Print_AS.hs revision 3d52aec7d9849d727bc457cd76ac93b3f523c629
a9de0a2f34860a24f457c777e740b7e87e6e3827Christian Maeder{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian MaederModule : $Header$
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiDescription : Printer for abstract syntax of CSL
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederCopyright : (c) Dominik Dietrich, Ewaryst Schulz, DFKI Bremen 2010
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiLicense : GPLv2 or higher, see LICENSE.txt
2eeec5240b424984e3ee26296da1eeab6c6d739eChristian MaederMaintainer : Ewaryst.Schulz@dfki.de
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiStability : experimental
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiPortability : portable
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederPretty printing the abstract syntax of CSL.
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder ( printExpression
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , printAssDefinition
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski , printConstantName
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , ExpressionPrinter (..)
ef9e8535c168d3f774d9e74368a2317a9eda5826Christian Maederimport Numeric
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- * Pretty Printing
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederinstance Pretty GroundConstant where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printGC
adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maederinstance Pretty Domain where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder pretty = printDomain
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty EP_decl where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder pretty = printEPDecl
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Pretty OP_ITEM where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder pretty = printOpItem
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Pretty VAR_ITEM where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder pretty = printVarItem
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Pretty BASIC_SPEC where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder pretty = printBasicSpec
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance Pretty BASIC_ITEM where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder pretty = printBasicItems
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty EXTPARAM where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printExtparam
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty EXPRESSION where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = head . printExpression
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty SYMB_ITEMS where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printSymbItems
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty SYMB where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printSymbol
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty SYMB_MAP_ITEMS where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder pretty = printSymbMapItems
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederinstance Pretty SYMB_OR_MAP where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder pretty = printSymbOrMap
adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maederinstance Pretty CMD where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = head . printCMD
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty ConstantName where
adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maeder pretty = printConstantName
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty AssDefinition where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder pretty = head . printAssDefinition
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty OPID where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = head . printOPID
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | A monad for printing of constants. This turns the pretty printing facility
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- more flexible w.r.t. the output of 'ConstantName'.
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiclass Monad m => ExpressionPrinter m where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder getOINM :: m OpInfoNameMap
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski getOINM = return operatorInfoNameMap
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski printConstant :: ConstantName -> m Doc
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder printConstant = return . printConstantName
adea2e45fa61f1097aadc490a0aeaf4831b729ccChristian Maeder printOpname :: OPNAME -> m Doc
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder printOpname = return . text . showOPNAME
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski prefixMode :: m Bool
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski prefixMode = return False
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski printArgs :: [Doc] -> m Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder printArgs = return . parens . sepByCommas
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski printVarDecl :: String -> m Doc
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder printVarDecl = return . text
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder printInterval :: Double -> Double -> m Doc
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder printInterval l r =
e7d2b3903c7b44db432538b0d720c21062c24823Christian Maeder return $ brackets $ sepByCommas $ map (text . show) [l, r]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski printRational :: APFloat -> m Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski printRational r = return $ text $ showFloat ((fromRat r) :: Double) ""
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | The default ConstantName printer
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintConstantName :: ConstantName -> Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintConstantName (SimpleConstant s) = text s
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintConstantName (ElimConstant s i) =
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski text $ if i > 0 then s ++ "__" ++ show i else s
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintAssDefinition :: ExpressionPrinter m => AssDefinition -> m Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintAssDefinition (ConstDef e) = printExpression e >>= return . (text "=" <+>)
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintAssDefinition (FunDef l e) = do
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski ed <- printExpression e
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski l' <- mapM printVarDecl l
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski args <- printArgs l'
a98fd29a06e80e447af26d898044c23497adbc73Mihai Codescu return $ args <+> text "=" <+> ed
a98fd29a06e80e447af26d898044c23497adbc73Mihai CodescuprintOPID :: ExpressionPrinter m => OPID -> m Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintOPID (OpUser c) = printConstant c
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintOPID (OpId oi) = printOpname oi
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- a dummy instance, we take the simplest monad
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance ExpressionPrinter []
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | An 'OpInfoNameMap' can be interpreted as an 'ExpressionPrinter'
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance ExpressionPrinter (Reader OpInfoNameMap) where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski getOINM = ask
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintCMD :: ExpressionPrinter m => CMD -> m Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintCMD (Ass c def) = do
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski [c', def'] <- mapM printExpression [c, def]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski return $ c' <+> text ":=" <+> def'
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintCMD c@(Cmd s exps) -- TODO: remove the case := later
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski | s == ":=" = error $ "printCMD: use Ass for assignment representation! "
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski | s == "constraint" = printExpression (exps !! 0)
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski | otherwise = let f l = text s <> parens (sepByCommas l)
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski in liftM f $ mapM printExpression exps
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintCMD (Repeat e stms) = do
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder e' <- printExpression e
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let f l = text "re" <>
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder (text "peat" $+$ vcat (map (text "." <+>) l))
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder $+$ text "until" <+> e'
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder liftM f $ mapM printCMD stms
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintCMD (Sequence stms) =
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let f l = text "se" <> (text "quence" $+$ vcat (map (text "." <+>) l))
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder $+$ text "end"
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in liftM f $ mapM printCMD stms
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintCMD (Cond l) = let f l' = vcat l' $+$ text "end"
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in liftM f $ mapM (uncurry printCase) l
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintCase :: ExpressionPrinter m => EXPRESSION -> [CMD] -> m Doc
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederprintCase e l = do
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder e' <- printExpression e
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder let f l' = text "ca" <> (text "se" <+> e' <> text ":"
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder $+$ vcat (map (text "." <+>) l'))
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder liftM f $ mapM printCMD l
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetPrec :: OpInfoNameMap -> EXPRESSION -> Int
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetPrec oinm (Op s _ exps _)
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | length exps == 0 = maxPrecedence + 1
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | otherwise =
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder case lookupOpInfo oinm s $ length exps of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Right oi -> prec oi
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Left True -> error $
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder concat [ "getPrec: registered operator ", show s, " used "
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder , "with non-registered arity ", show $ length exps ]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder _ -> maxPrecedence -- this is probably a user-defined prefix function
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder -- , binds strongly
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaedergetPrec _ _ = maxPrecedence
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetOp :: EXPRESSION -> Maybe OPID
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetOp (Op s _ _ _) = Just s
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetOp _ = Nothing
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExtparam :: EXTPARAM -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExtparam (EP p op i) =
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder pretty p <> text op <> (if op == "-|" then empty else text $ show i)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederprintExtparams :: [EXTPARAM] -> Doc
4d7d53fec6b551333c79da6ae3b8ca2af0a741abChristian MaederprintExtparams [] = empty
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExtparams l = brackets $ sepByCommas $ map printExtparam l
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian MaederprintInfix :: ExpressionPrinter m => EXPRESSION -> m Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintInfix e@(Op s _ exps@[e1, e2] _) = do
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- we mustn't omit the space between the operator and its arguments for text-
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder-- operators such as "and", "or", but it would be good to omit it for "+-*/"
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder oi <- printOPID s
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder oinm <- getOINM
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let outerprec = getPrec oinm e
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich f cmp e' ed = if cmp outerprec $ getPrec oinm e' then ed else parens ed
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder g [ed1, ed2] = let cmp = case getOp e1 of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Just op1 | op1 == s -> (<=)
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | otherwise -> (<)
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in sep[f cmp e1 ed1, oi <+> f (<) e2 ed2]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder g _ = error "printInfix: Inner impossible case"
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder liftM g $ mapM printExpression exps
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintInfix _ = error "printInfix: Impossible case"
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExpression :: ExpressionPrinter m => EXPRESSION -> m Doc
e7d2b3903c7b44db432538b0d720c21062c24823Christian MaederprintExpression (Var token) = return $ text $ tokStr token
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExpression e@(Op s epl exps _)
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | length exps == 0 = liftM (<> printExtparams epl) $ printOPID s
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | otherwise = do
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let asPrfx pexps = do
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder oid <- printOPID s
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder args <- printArgs pexps
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder return $ oid <> printExtparams epl <> args
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder asPrfx' = mapM printExpression exps >>= asPrfx
e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder oinm <- getOINM
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder pfxMode <- prefixMode
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder if pfxMode then asPrfx' else
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder case lookupOpInfo oinm s $ length exps of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | infx oi -> printInfix e
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder | otherwise -> asPrfx'
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExpression (List exps _) = liftM sepByCommas (mapM printExpression exps)
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus LuettichprintExpression (Int i _) = return $ text (show i)
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintExpression (Rat r _) = printRational r
e7d2b3903c7b44db432538b0d720c21062c24823Christian MaederprintExpression (Interval l r _) = printInterval l r
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintOpItem :: OP_ITEM -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintOpItem (Op_item tokens _) =
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder text "operator" <+> sepByCommas (map pretty tokens)
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintVarItem :: VAR_ITEM -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintVarItem (Var_item vars dom _) =
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder hsep [sepByCommas $ map pretty vars, text "in", pretty dom]
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintEPDecl :: EP_decl -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintEPDecl (EP_decl tk mDom mDef) =
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder let tkD = pretty tk
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder domD = case mDom of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Just dom -> hsep [tkD, text "in", pretty dom]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder in case mDef of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Just def -> sepByCommas [domD, hsep [tkD, text "default=", pretty def]]
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintDomain :: Domain -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintDomain (Set s) = pretty s
556f473448dfcceee22afaa89ed7a364489cdbbbChristian MaederprintDomain (IntVal (c1, b1) (c2, b2)) =
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder hcat [ getIBorder True b1, sepByCommas $ map printGC [c1, c2]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder , getIBorder False b2]
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetIBorder :: Bool -> Bool -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaedergetIBorder False False = lbrack
a98fd29a06e80e447af26d898044c23497adbc73Mihai CodescugetIBorder True True = lbrack
a98fd29a06e80e447af26d898044c23497adbc73Mihai CodescugetIBorder _ _ = rbrack
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintGC :: GroundConstant -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintGC (GCI i) = text (show i)
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintGC (GCR d) = text (show d)
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintBasicSpec :: BASIC_SPEC -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintBasicSpec (Basic_spec xs) = vcat $ map pretty xs
a98fd29a06e80e447af26d898044c23497adbc73Mihai CodescuprintBasicItems :: BASIC_ITEM -> Doc
a98fd29a06e80e447af26d898044c23497adbc73Mihai CodescuprintBasicItems (Axiom_item x) = pretty x
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintBasicItems (Op_decl x) = pretty x
a98fd29a06e80e447af26d898044c23497adbc73Mihai CodescuprintBasicItems (Var_decls x) = text "vars" <+> (sepBySemis $ map pretty x)
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintSymbol :: SYMB -> Doc
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintSymbol (Symb_id sym) = pretty sym
09b431a868c79a92ae7c9bd141565f43f9034144Christian MaederprintSymbItems :: SYMB_ITEMS -> Doc
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederprintSymbItems (Symb_items xs _) = fsep $ map pretty xs
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederprintSymbOrMap :: SYMB_OR_MAP -> Doc
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederprintSymbOrMap (Symb sym) = pretty sym
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederprintSymbOrMap (Symb_map source dest _) =
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder pretty source <+> mapsto <+> pretty dest
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederprintSymbMapItems :: SYMB_MAP_ITEMS -> Doc
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian MaederprintSymbMapItems (Symb_map_items xs _) = fsep $ map pretty xs
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder-- Instances for GetRange
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maederinstance GetRange OP_ITEM where
c911a0ec80ca4a178399c68f1e28be4e2bf42fceChristian Maeder getRange = Range . rangeSpan
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder rangeSpan x = case x of
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder Op_item a b -> joinRanges [rangeSpan a, rangeSpan b]
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maederinstance GetRange VAR_ITEM where
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder getRange = Range . rangeSpan
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder rangeSpan x = case x of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Var_item a _ b -> joinRanges [rangeSpan a, rangeSpan b]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederinstance GetRange BASIC_SPEC where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder getRange = Range . rangeSpan
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder rangeSpan x = case x of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Basic_spec a -> joinRanges [rangeSpan a]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederinstance GetRange BASIC_ITEM where
e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder getRange = Range . rangeSpan
e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder rangeSpan x = case x of
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Op_decl a -> joinRanges [rangeSpan a]
e8eb2b9d68adc3024eb1aa9899b902ed5a3fb460Christian Maeder Var_decls a -> joinRanges [rangeSpan a]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder Axiom_item a -> joinRanges [rangeSpan a]
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maederinstance GetRange CMD where
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder getRange = Range . rangeSpan
09b431a868c79a92ae7c9bd141565f43f9034144Christian Maeder rangeSpan (Ass c def) = joinRanges (map rangeSpan [c, def])
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich rangeSpan (Cmd _ exps) = joinRanges (map rangeSpan exps)
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich -- parsing guruantees l <> null
c40a1fdc8ec6978bd27240d6780d0e0a7b6b0056Dominik Luecke rangeSpan (Repeat c l) = joinRanges [rangeSpan c, rangeSpan $ head l]
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich -- parsing guruantees l <> null
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan (Sequence l) = rangeSpan $ head l
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan (Cond l) = rangeSpan $ head l
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance GetRange SYMB_ITEMS where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder getRange = Range . rangeSpan
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan (Symb_items a b) = joinRanges [rangeSpan a, rangeSpan b]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance GetRange SYMB where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder getRange = Range . rangeSpan
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan (Symb_id a) = joinRanges [rangeSpan a]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance GetRange SYMB_MAP_ITEMS where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder getRange = Range . rangeSpan
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan (Symb_map_items a b) = joinRanges [rangeSpan a, rangeSpan b]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance GetRange SYMB_OR_MAP where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder getRange = Range . rangeSpan
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan x = case x of
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Symb a -> joinRanges [rangeSpan a]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Symb_map a b c -> joinRanges [rangeSpan a, rangeSpan b, rangeSpan c]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maederinstance GetRange EXPRESSION where
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder getRange = Range . rangeSpan
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder rangeSpan x = case x of
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Var token -> joinRanges [rangeSpan token]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Op _ _ exps a -> joinRanges $ [rangeSpan a] ++ (map rangeSpan exps)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder List exps a -> joinRanges $ [rangeSpan a] ++ (map rangeSpan exps)
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Int _ a -> joinRanges [rangeSpan a]
556f473448dfcceee22afaa89ed7a364489cdbbbChristian Maeder Rat _ a -> joinRanges [rangeSpan a]