{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{- |
Module      :  ./CSL/Print_AS.hs
Description :  Printer for abstract syntax of CSL
Copyright   :  (c) Dominik Dietrich, Ewaryst Schulz, DFKI Bremen 2010
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Ewaryst.Schulz@dfki.de
Stability   :  experimental
Portability :  portable

Pretty printing the abstract syntax of CSL.

-}

module CSL.Print_AS
    ( printExpression
    , printCMD
    , printAssDefinition
    , printConstantName
    , ExpressionPrinter (..)
    ) where

import Common.Id as Id
import Common.Doc
import Common.DocUtils

import Control.Monad
import Control.Monad.Reader

import Numeric

import CSL.AS_BASIC_CSL
import CSL.TreePO


-- * Pretty Printing

instance Pretty InfInt where
    pretty :: InfInt -> Doc
pretty = InfInt -> Doc
printInfInt
instance Pretty GroundConstant where
    pretty :: GroundConstant -> Doc
pretty = GroundConstant -> Doc
printGC
instance (Ord a, Pretty a) => Pretty (SetOrInterval a) where
    pretty :: SetOrInterval a -> Doc
pretty = SetOrInterval a -> Doc
forall a. (Ord a, Pretty a) => SetOrInterval a -> Doc
printDomain
instance Pretty a => Pretty (ClosedInterval a) where
    pretty :: ClosedInterval a -> Doc
pretty = ClosedInterval a -> Doc
forall a. Pretty a => ClosedInterval a -> Doc
printClosedInterval

instance Pretty OpDecl where
    pretty :: OpDecl -> Doc
pretty = [Doc] -> Doc
forall a. [a] -> a
head ([Doc] -> Doc) -> (OpDecl -> [Doc]) -> OpDecl -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpDecl -> [Doc]
forall (m :: * -> *). ExpressionPrinter m => OpDecl -> m Doc
printOpDecl
instance Pretty VarDecl where
    pretty :: VarDecl -> Doc
pretty = VarDecl -> Doc
printVarDecl
instance Pretty EPVal where
    pretty :: EPVal -> Doc
pretty = EPVal -> Doc
printEPVal

instance Pretty EPDecl where
    pretty :: EPDecl -> Doc
pretty = EPDecl -> Doc
printEPDecl
instance Pretty OP_ITEM where
    pretty :: OP_ITEM -> Doc
pretty = OP_ITEM -> Doc
printOpItem
instance Pretty VAR_ITEM where
    pretty :: VAR_ITEM -> Doc
pretty = VAR_ITEM -> Doc
printVarItem
instance Pretty BASIC_SPEC where
    pretty :: BASIC_SPEC -> Doc
pretty = BASIC_SPEC -> Doc
printBasicSpec
instance Pretty BASIC_ITEM where
    pretty :: BASIC_ITEM -> Doc
pretty = BASIC_ITEM -> Doc
printBasicItems
instance Pretty EXTPARAM where
    pretty :: EXTPARAM -> Doc
pretty = EXTPARAM -> Doc
printExtparam
instance Pretty EXPRESSION where
    pretty :: EXPRESSION -> Doc
pretty = [Doc] -> Doc
forall a. [a] -> a
head ([Doc] -> Doc) -> (EXPRESSION -> [Doc]) -> EXPRESSION -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EXPRESSION -> [Doc]
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression
instance Pretty SYMB_ITEMS where
    pretty :: SYMB_ITEMS -> Doc
pretty = SYMB_ITEMS -> Doc
printSymbItems
instance Pretty SYMB where
    pretty :: SYMB -> Doc
pretty = SYMB -> Doc
printSymbol
instance Pretty SYMB_MAP_ITEMS where
    pretty :: SYMB_MAP_ITEMS -> Doc
pretty = SYMB_MAP_ITEMS -> Doc
printSymbMapItems
instance Pretty SYMB_OR_MAP where
    pretty :: SYMB_OR_MAP -> Doc
pretty = SYMB_OR_MAP -> Doc
printSymbOrMap
instance Pretty CMD where
    pretty :: CMD -> Doc
pretty = [Doc] -> Doc
forall a. [a] -> a
head ([Doc] -> Doc) -> (CMD -> [Doc]) -> CMD -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMD -> [Doc]
forall (m :: * -> *). ExpressionPrinter m => CMD -> m Doc
printCMD
instance Pretty ConstantName where
    pretty :: ConstantName -> Doc
pretty = ConstantName -> Doc
printConstantName
instance Pretty AssDefinition where
    pretty :: AssDefinition -> Doc
pretty = [Doc] -> Doc
forall a. [a] -> a
head ([Doc] -> Doc) -> (AssDefinition -> [Doc]) -> AssDefinition -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssDefinition -> [Doc]
forall (m :: * -> *). ExpressionPrinter m => AssDefinition -> m Doc
printAssDefinition
instance Pretty OPID where
    pretty :: OPID -> Doc
pretty = [Doc] -> Doc
forall a. [a] -> a
head ([Doc] -> Doc) -> (OPID -> [Doc]) -> OPID -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OPID -> [Doc]
forall (m :: * -> *). ExpressionPrinter m => OPID -> m Doc
printOPID


{- | A monad for printing of constants. This turns the pretty printing facility
more flexible w.r.t. the output of 'ConstantName'. -}
class Monad m => ExpressionPrinter m where
    getOINM :: m OpInfoNameMap
    getOINM = OpInfoNameMap -> m OpInfoNameMap
forall (m :: * -> *) a. Monad m => a -> m a
return OpInfoNameMap
operatorInfoNameMap
    printConstant :: ConstantName -> m Doc
    printConstant = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> (ConstantName -> Doc) -> ConstantName -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstantName -> Doc
printConstantName
    printOpname :: OPNAME -> m Doc
    printOpname = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> (OPNAME -> Doc) -> OPNAME -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> Doc) -> (OPNAME -> String) -> OPNAME -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OPNAME -> String
showOPNAME
    prefixMode :: m Bool
    prefixMode = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    printArgs :: [Doc] -> m Doc
    printArgs = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> ([Doc] -> Doc) -> [Doc] -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
sepByCommas
    printArgPattern :: String -> m Doc
    printArgPattern = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> (String -> Doc) -> String -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text
    printInterval :: Double -> Double -> m Doc
    printInterval l :: Double
l r :: Double
r =
        Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Double -> Doc) -> [Double] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (Double -> String) -> Double -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) [Double
l, Double
r]
    printRational :: APFloat -> m Doc
    printRational r :: APFloat
r = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Double -> ShowS
forall a. RealFloat a => a -> ShowS
showFloat (APFloat -> Double
forall a. RealFloat a => APFloat -> a
fromRat APFloat
r :: Double) ""


-- | The default ConstantName printer
printConstantName :: ConstantName -> Doc
printConstantName :: ConstantName -> Doc
printConstantName (SimpleConstant s :: String
s) = String -> Doc
text String
s
printConstantName (ElimConstant s :: String
s i :: Int
i) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "__" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i else String
s

printAssDefinition :: ExpressionPrinter m => AssDefinition -> m Doc
printAssDefinition :: AssDefinition -> m Doc
printAssDefinition (ConstDef e :: EXPRESSION
e) = (Doc -> Doc) -> m Doc -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String -> Doc
text "=" Doc -> Doc -> Doc
<+>) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression EXPRESSION
e
printAssDefinition (FunDef l :: [String]
l e :: EXPRESSION
e) = do
  Doc
ed <- EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression EXPRESSION
e
  [Doc]
l' <- (String -> m Doc) -> [String] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m Doc
forall (m :: * -> *). ExpressionPrinter m => String -> m Doc
printArgPattern [String]
l
  Doc
args <- [Doc] -> m Doc
forall (m :: * -> *). ExpressionPrinter m => [Doc] -> m Doc
printArgs [Doc]
l'
  Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc
args Doc -> Doc -> Doc
<+> String -> Doc
text "=" Doc -> Doc -> Doc
<+> Doc
ed

printOPID :: ExpressionPrinter m => OPID -> m Doc
printOPID :: OPID -> m Doc
printOPID (OpUser c :: ConstantName
c) = ConstantName -> m Doc
forall (m :: * -> *). ExpressionPrinter m => ConstantName -> m Doc
printConstant ConstantName
c
printOPID (OpId oi :: OPNAME
oi) = OPNAME -> m Doc
forall (m :: * -> *). ExpressionPrinter m => OPNAME -> m Doc
printOpname OPNAME
oi

-- a dummy instance, we take the simplest monad
instance ExpressionPrinter []

-- | An 'OpInfoNameMap' can be interpreted as an 'ExpressionPrinter'
instance ExpressionPrinter (Reader OpInfoNameMap) where
    getOINM :: Reader OpInfoNameMap OpInfoNameMap
getOINM = Reader OpInfoNameMap OpInfoNameMap
forall r (m :: * -> *). MonadReader r m => m r
ask


printCMD :: ExpressionPrinter m => CMD -> m Doc
printCMD :: CMD -> m Doc
printCMD (Ass c :: OpDecl
c def :: EXPRESSION
def) = do
  Doc
def' <- EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression EXPRESSION
def
  Doc
c' <- OpDecl -> m Doc
forall (m :: * -> *). ExpressionPrinter m => OpDecl -> m Doc
printOpDecl OpDecl
c
  Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc
c' Doc -> Doc -> Doc
<+> String -> Doc
text ":=" Doc -> Doc -> Doc
<+> Doc
def'
printCMD c :: CMD
c@(Cmd s :: String
s exps :: [EXPRESSION]
exps) -- TODO: remove the case := later
    | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ":=" = String -> m Doc
forall a. HasCallStack => String -> a
error (String -> m Doc) -> String -> m Doc
forall a b. (a -> b) -> a -> b
$ "printCMD: use Ass for assignment representation! "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ CMD -> String
forall a. Show a => a -> String
show CMD
c
    | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "constraint" = EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression ([EXPRESSION] -> EXPRESSION
forall a. [a] -> a
head [EXPRESSION]
exps)
    | Bool
otherwise = let f :: [Doc] -> Doc
f l :: [Doc]
l = String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
sepByCommas [Doc]
l)
                  in ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
f (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (EXPRESSION -> m Doc) -> [EXPRESSION] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression [EXPRESSION]
exps
printCMD (Repeat e :: EXPRESSION
e stms :: [CMD]
stms) = do
  Doc
e' <- EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression EXPRESSION
e
  let f :: [Doc] -> Doc
f l :: [Doc]
l = String -> Doc
text "re" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
               (String -> Doc
text "peat" Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text "." Doc -> Doc -> Doc
<+>) [Doc]
l))
               Doc -> Doc -> Doc
$+$ String -> Doc
text "until" Doc -> Doc -> Doc
<+> Doc
e'
  ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
f (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (CMD -> m Doc) -> [CMD] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CMD -> m Doc
forall (m :: * -> *). ExpressionPrinter m => CMD -> m Doc
printCMD [CMD]
stms

printCMD (Sequence stms :: [CMD]
stms) =
    let f :: [Doc] -> Doc
f l :: [Doc]
l = String -> Doc
text "se" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (String -> Doc
text "quence" Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text "." Doc -> Doc -> Doc
<+>) [Doc]
l))
              Doc -> Doc -> Doc
$+$ String -> Doc
text "end"
    in ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
f (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (CMD -> m Doc) -> [CMD] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CMD -> m Doc
forall (m :: * -> *). ExpressionPrinter m => CMD -> m Doc
printCMD [CMD]
stms

printCMD (Cond l :: [(EXPRESSION, [CMD])]
l) = let f :: [Doc] -> Doc
f l' :: [Doc]
l' = [Doc] -> Doc
vcat [Doc]
l' Doc -> Doc -> Doc
$+$ String -> Doc
text "end"
                    in ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
f (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ ((EXPRESSION, [CMD]) -> m Doc) -> [(EXPRESSION, [CMD])] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((EXPRESSION -> [CMD] -> m Doc) -> (EXPRESSION, [CMD]) -> m Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry EXPRESSION -> [CMD] -> m Doc
forall (m :: * -> *).
ExpressionPrinter m =>
EXPRESSION -> [CMD] -> m Doc
printCase) [(EXPRESSION, [CMD])]
l

printCase :: ExpressionPrinter m => EXPRESSION -> [CMD] -> m Doc
printCase :: EXPRESSION -> [CMD] -> m Doc
printCase e :: EXPRESSION
e l :: [CMD]
l = do
  Doc
e' <- EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression EXPRESSION
e
  let f :: [Doc] -> Doc
f l' :: [Doc]
l' = String -> Doc
text "ca" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (String -> Doc
text "se" Doc -> Doc -> Doc
<+> Doc
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text ":"
                                       Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text "." Doc -> Doc -> Doc
<+>) [Doc]
l'))
  ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
f (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (CMD -> m Doc) -> [CMD] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CMD -> m Doc
forall (m :: * -> *). ExpressionPrinter m => CMD -> m Doc
printCMD [CMD]
l


getPrec :: OpInfoNameMap -> EXPRESSION -> Int
getPrec :: OpInfoNameMap -> EXPRESSION -> Int
getPrec oinm :: OpInfoNameMap
oinm (Op s :: OPID
s _ exps :: [EXPRESSION]
exps _)
 | [EXPRESSION] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EXPRESSION]
exps = Int
maxPrecedence Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
 | Bool
otherwise =
     case OpInfoNameMap -> OPID -> Int -> Either Bool OpInfo
lookupOpInfo OpInfoNameMap
oinm OPID
s (Int -> Either Bool OpInfo) -> Int -> Either Bool OpInfo
forall a b. (a -> b) -> a -> b
$ [EXPRESSION] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EXPRESSION]
exps of
       Right oi :: OpInfo
oi -> OpInfo -> Int
prec OpInfo
oi
       Left True -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "getPrec: registered operator ", OPID -> String
forall a. Show a => a -> String
show OPID
s, " used "
                           , "with non-registered arity ", Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [EXPRESSION] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EXPRESSION]
exps ]
       _ -> Int
maxPrecedence {- this is probably a user-defined prefix function
                          , binds strongly -}
getPrec _ _ = Int
maxPrecedence

getOp :: EXPRESSION -> Maybe OPID
getOp :: EXPRESSION -> Maybe OPID
getOp (Op s :: OPID
s _ _ _) = OPID -> Maybe OPID
forall a. a -> Maybe a
Just OPID
s
getOp _ = Maybe OPID
forall a. Maybe a
Nothing

printExtparam :: EXTPARAM -> Doc
printExtparam :: EXTPARAM -> Doc
printExtparam (EP p :: Token
p op :: String
op i :: APInt
i) =
    Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (if String
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-|" then Doc
empty else String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ APInt -> String
forall a. Show a => a -> String
show APInt
i)

printExtparams :: [EXTPARAM] -> Doc
printExtparams :: [EXTPARAM] -> Doc
printExtparams [] = Doc
empty
printExtparams l :: [EXTPARAM]
l = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (EXTPARAM -> Doc) -> [EXTPARAM] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map EXTPARAM -> Doc
printExtparam [EXTPARAM]
l

printInfix :: ExpressionPrinter m => EXPRESSION -> m Doc
printInfix :: EXPRESSION -> m Doc
printInfix e :: EXPRESSION
e@(Op s :: OPID
s _ exps :: [EXPRESSION]
exps@[e1 :: EXPRESSION
e1, e2 :: EXPRESSION
e2] _) = do
{- we mustn't omit the space between the operator and its arguments for text-
operators such as "and", "or", but it would be good to omit it for "+-*/" -}
  Doc
oi <- OPID -> m Doc
forall (m :: * -> *). ExpressionPrinter m => OPID -> m Doc
printOPID OPID
s
  OpInfoNameMap
oinm <- m OpInfoNameMap
forall (m :: * -> *). ExpressionPrinter m => m OpInfoNameMap
getOINM
  let outerprec :: Int
outerprec = OpInfoNameMap -> EXPRESSION -> Int
getPrec OpInfoNameMap
oinm EXPRESSION
e
      f :: (Int -> Int -> Bool) -> EXPRESSION -> Doc -> Doc
f cmp :: Int -> Int -> Bool
cmp e' :: EXPRESSION
e' ed :: Doc
ed = if Int -> Int -> Bool
cmp Int
outerprec (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ OpInfoNameMap -> EXPRESSION -> Int
getPrec OpInfoNameMap
oinm EXPRESSION
e' then Doc
ed else Doc -> Doc
parens Doc
ed
      g :: [Doc] -> Doc
g [ed1 :: Doc
ed1, ed2 :: Doc
ed2] = let cmp :: Int -> Int -> Bool
cmp = case EXPRESSION -> Maybe OPID
getOp EXPRESSION
e1 of
                                 Just op1 :: OPID
op1 | OPID
op1 OPID -> OPID -> Bool
forall a. Eq a => a -> a -> Bool
== OPID
s -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
                                          | Bool
otherwise -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)
                                 _ -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)
                     in [Doc] -> Doc
sep [(Int -> Int -> Bool) -> EXPRESSION -> Doc -> Doc
f Int -> Int -> Bool
cmp EXPRESSION
e1 Doc
ed1, Doc
oi Doc -> Doc -> Doc
<+> (Int -> Int -> Bool) -> EXPRESSION -> Doc -> Doc
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<) EXPRESSION
e2 Doc
ed2]
      g _ = String -> Doc
forall a. HasCallStack => String -> a
error "printInfix: Inner impossible case"
  ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
g (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (EXPRESSION -> m Doc) -> [EXPRESSION] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression [EXPRESSION]
exps
printInfix _ = String -> m Doc
forall a. HasCallStack => String -> a
error "printInfix: Impossible case"

printExpression :: ExpressionPrinter m => EXPRESSION -> m Doc
printExpression :: EXPRESSION -> m Doc
printExpression (Var token :: Token
token) = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Token -> String
tokStr Token
token
printExpression e :: EXPRESSION
e@(Op s :: OPID
s epl :: [EXTPARAM]
epl exps :: [EXPRESSION]
exps _)
    | [EXPRESSION] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EXPRESSION]
exps = (Doc -> Doc) -> m Doc -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [EXTPARAM] -> Doc
printExtparams [EXTPARAM]
epl) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ OPID -> m Doc
forall (m :: * -> *). ExpressionPrinter m => OPID -> m Doc
printOPID OPID
s
    | Bool
otherwise = do
        let asPrfx :: [Doc] -> m Doc
asPrfx pexps :: [Doc]
pexps = do
                    Doc
oid <- OPID -> m Doc
forall (m :: * -> *). ExpressionPrinter m => OPID -> m Doc
printOPID OPID
s
                    Doc
args <- [Doc] -> m Doc
forall (m :: * -> *). ExpressionPrinter m => [Doc] -> m Doc
printArgs [Doc]
pexps
                    Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc
oid Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [EXTPARAM] -> Doc
printExtparams [EXTPARAM]
epl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
args
            asPrfx' :: m Doc
asPrfx' = (EXPRESSION -> m Doc) -> [EXPRESSION] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression [EXPRESSION]
exps m [Doc] -> ([Doc] -> m Doc) -> m Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Doc] -> m Doc
forall (m :: * -> *). ExpressionPrinter m => [Doc] -> m Doc
asPrfx
        OpInfoNameMap
oinm <- m OpInfoNameMap
forall (m :: * -> *). ExpressionPrinter m => m OpInfoNameMap
getOINM
        Bool
pfxMode <- m Bool
forall (m :: * -> *). ExpressionPrinter m => m Bool
prefixMode
        if Bool
pfxMode then m Doc
asPrfx' else
            case OpInfoNameMap -> OPID -> Int -> Either Bool OpInfo
lookupOpInfo OpInfoNameMap
oinm OPID
s (Int -> Either Bool OpInfo) -> Int -> Either Bool OpInfo
forall a b. (a -> b) -> a -> b
$ [EXPRESSION] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EXPRESSION]
exps of
              Right oi :: OpInfo
oi
                  | OpInfo -> Bool
infx OpInfo
oi -> EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printInfix EXPRESSION
e
                  | Bool
otherwise -> m Doc
asPrfx'
              _ -> m Doc
asPrfx'

printExpression (List exps :: [EXPRESSION]
exps _) = ([Doc] -> Doc) -> m [Doc] -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc] -> Doc
sepByCommas ((EXPRESSION -> m Doc) -> [EXPRESSION] -> m [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EXPRESSION -> m Doc
forall (m :: * -> *). ExpressionPrinter m => EXPRESSION -> m Doc
printExpression [EXPRESSION]
exps)
printExpression (Int i :: APInt
i _) = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (APInt -> String
forall a. Show a => a -> String
show APInt
i)
printExpression (Rat r :: APFloat
r _) = APFloat -> m Doc
forall (m :: * -> *). ExpressionPrinter m => APFloat -> m Doc
printRational APFloat
r
printExpression (Interval l :: Double
l r :: Double
r _) = Double -> Double -> m Doc
forall (m :: * -> *).
ExpressionPrinter m =>
Double -> Double -> m Doc
printInterval Double
l Double
r

printOpItem :: OP_ITEM -> Doc
printOpItem :: OP_ITEM -> Doc
printOpItem (Op_item tokens :: [Token]
tokens _) =
    String -> Doc
text "operator" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sepByCommas ((Token -> Doc) -> [Token] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc
forall a. Pretty a => a -> Doc
pretty [Token]
tokens)

printVarItem :: VAR_ITEM -> Doc
printVarItem :: VAR_ITEM -> Doc
printVarItem (Var_item vars :: [Token]
vars dom :: Domain
dom _) =
    [Doc] -> Doc
hsep [[Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Token -> Doc) -> [Token] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc
forall a. Pretty a => a -> Doc
pretty [Token]
vars, String -> Doc
text "in", Domain -> Doc
forall a. Pretty a => a -> Doc
pretty Domain
dom]


instance Pretty Ordering where
    pretty :: Ordering -> Doc
pretty LT = String -> Doc
text "<"
    pretty GT = String -> Doc
text ">"
    pretty EQ = String -> Doc
text "="

printVarDecl :: VarDecl -> Doc
printVarDecl :: VarDecl -> Doc
printVarDecl (VarDecl n :: Token
n (Just dom :: Domain
dom)) = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
n Doc -> Doc -> Doc
<+> String -> Doc
text "in" Doc -> Doc -> Doc
<+> Domain -> Doc
forall a. (Ord a, Pretty a) => SetOrInterval a -> Doc
printDomain Domain
dom
printVarDecl (VarDecl n :: Token
n Nothing) = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
n

printOpDecl :: ExpressionPrinter m => OpDecl -> m Doc
printOpDecl :: OpDecl -> m Doc
printOpDecl (OpDecl n :: ConstantName
n epl :: [EXTPARAM]
epl vdl :: [VarDecl]
vdl _)
    | [VarDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VarDecl]
vdl = (Doc -> Doc) -> m Doc -> m Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [EXTPARAM] -> Doc
printExtparams [EXTPARAM]
epl) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ ConstantName -> m Doc
forall (m :: * -> *). ExpressionPrinter m => ConstantName -> m Doc
printConstant ConstantName
n
    | Bool
otherwise = do
         Doc
oid <- ConstantName -> m Doc
forall (m :: * -> *). ExpressionPrinter m => ConstantName -> m Doc
printConstant ConstantName
n
         Doc
args <- [Doc] -> m Doc
forall (m :: * -> *). ExpressionPrinter m => [Doc] -> m Doc
printArgs ([Doc] -> m Doc) -> [Doc] -> m Doc
forall a b. (a -> b) -> a -> b
$ (VarDecl -> Doc) -> [VarDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VarDecl -> Doc
printVarDecl [VarDecl]
vdl
         Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc
oid Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [EXTPARAM] -> Doc
printExtparams [EXTPARAM]
epl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
args

printEPVal :: EPVal -> Doc
printEPVal :: EPVal -> Doc
printEPVal (EPVal i :: APInt
i) = APInt -> Doc
forall a. Pretty a => a -> Doc
pretty APInt
i
printEPVal (EPConstRef r :: Token
r) = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
r


printEPDecl :: EPDecl -> Doc
printEPDecl :: EPDecl -> Doc
printEPDecl (EPDecl tk :: Token
tk dom :: EPDomain
dom mDef :: Maybe APInt
mDef) =
    let tkD :: Doc
tkD = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
tk
        domD :: Doc
domD = Bool -> String -> (Token, EPDomain) -> Doc
forall a b. (Pretty a, Pretty b) => Bool -> String -> (a, b) -> Doc
printInfixWith Bool
True "in" (Token
tk, EPDomain
dom)
    in case Maybe APInt
mDef of
         Just def :: APInt
def -> [Doc] -> Doc
vcat [Doc
domD, [Doc] -> Doc
hsep [ String -> Doc
text "set", String -> Doc
text "default"
                                            , [Doc] -> Doc
hcat [Doc
tkD, String -> Doc
text "=", APInt -> Doc
forall a. Pretty a => a -> Doc
pretty APInt
def]]]
         _ -> Doc
domD


printClosedInterval :: Pretty a => ClosedInterval a -> Doc
printClosedInterval :: ClosedInterval a -> Doc
printClosedInterval (ClosedInterval l :: a
l r :: a
r) =
    [Doc] -> Doc
hcat [ Doc
lbrack, [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a
l, a
r], Doc
rbrack ]


printDomain :: (Ord a, Pretty a) => SetOrInterval a -> Doc
printDomain :: SetOrInterval a -> Doc
printDomain (Set s :: Set a
s) = Set a -> Doc
forall a. Pretty a => a -> Doc
pretty Set a
s
printDomain (IntVal (c1 :: a
c1, b1 :: Bool
b1) (c2 :: a
c2, b2 :: Bool
b2)) =
    [Doc] -> Doc
hcat [ Bool -> Bool -> Doc
getIBorder Bool
True Bool
b1, [Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a
c1, a
c2]
         , Bool -> Bool -> Doc
getIBorder Bool
False Bool
b2]

getIBorder :: Bool -> Bool -> Doc
getIBorder :: Bool -> Bool -> Doc
getIBorder False False = Doc
lbrack
getIBorder True True = Doc
lbrack
getIBorder _ _ = Doc
rbrack

printGC :: GroundConstant -> Doc
printGC :: GroundConstant -> Doc
printGC (GCI i :: APInt
i) = String -> Doc
text (APInt -> String
forall a. Show a => a -> String
show APInt
i)
printGC (GCR d :: APFloat
d) = String -> Doc
text (APFloat -> String
forall a. Show a => a -> String
show APFloat
d)

printInfInt :: InfInt -> Doc
printInfInt :: InfInt -> Doc
printInfInt NegInf = String -> Doc
text "-oo"
printInfInt PosInf = String -> Doc
text "oo"
printInfInt (FinInt x :: APInt
x) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ APInt -> String
forall a. Show a => a -> String
show APInt
x

printBasicSpec :: BASIC_SPEC -> Doc
printBasicSpec :: BASIC_SPEC -> Doc
printBasicSpec (Basic_spec xs :: [Annoted BASIC_ITEM]
xs) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Annoted BASIC_ITEM -> Doc) -> [Annoted BASIC_ITEM] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Annoted BASIC_ITEM -> Doc
forall a. Pretty a => a -> Doc
pretty [Annoted BASIC_ITEM]
xs

printBasicItems :: BASIC_ITEM -> Doc
printBasicItems :: BASIC_ITEM -> Doc
printBasicItems (Axiom_item x :: Annoted CMD
x) = Annoted CMD -> Doc
forall a. Pretty a => a -> Doc
pretty Annoted CMD
x
printBasicItems (Op_decl x :: OP_ITEM
x) = OP_ITEM -> Doc
forall a. Pretty a => a -> Doc
pretty OP_ITEM
x
printBasicItems (Var_decls x :: [VAR_ITEM]
x) = String -> Doc
text "vars" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sepBySemis ((VAR_ITEM -> Doc) -> [VAR_ITEM] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VAR_ITEM -> Doc
forall a. Pretty a => a -> Doc
pretty [VAR_ITEM]
x)
printBasicItems (EP_decl x :: [(Token, EPDomain)]
x) = String -> Doc
text "eps" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sepBySemis
                               (((Token, EPDomain) -> Doc) -> [(Token, EPDomain)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> (Token, EPDomain) -> Doc
forall a b. (Pretty a, Pretty b) => Bool -> String -> (a, b) -> Doc
printInfixWith Bool
True "in") [(Token, EPDomain)]
x)
printBasicItems (EP_domdecl x :: [(Token, APInt)]
x) =
    String -> Doc
text "set" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sepBySemis (((Token, APInt) -> Doc) -> [(Token, APInt)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> (Token, APInt) -> Doc
forall a b. (Pretty a, Pretty b) => Bool -> String -> (a, b) -> Doc
printInfixWith Bool
False "=") [(Token, APInt)]
x)
printBasicItems (EP_defval x :: [(Token, APInt)]
x) = String -> Doc
text "set" Doc -> Doc -> Doc
<+> String -> Doc
text "default" Doc -> Doc -> Doc
<+>
                                [Doc] -> Doc
sepBySemis (((Token, APInt) -> Doc) -> [(Token, APInt)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> (Token, APInt) -> Doc
forall a b. (Pretty a, Pretty b) => Bool -> String -> (a, b) -> Doc
printInfixWith Bool
False "=") [(Token, APInt)]
x)

printInfixWith :: (Pretty a, Pretty b) => Bool -> String -> (a, b) -> Doc
printInfixWith :: Bool -> String -> (a, b) -> Doc
printInfixWith b :: Bool
b s :: String
s (x :: a
x, y :: b
y) = [Doc] -> Doc
sep' [a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x, String -> Doc
text String
s, b -> Doc
forall a. Pretty a => a -> Doc
pretty b
y]
    where sep' :: [Doc] -> Doc
sep' = if Bool
b then [Doc] -> Doc
hsep else [Doc] -> Doc
hcat

printSymbol :: SYMB -> Doc
printSymbol :: SYMB -> Doc
printSymbol (Symb_id sym :: Token
sym) = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
sym

printSymbItems :: SYMB_ITEMS -> Doc
printSymbItems :: SYMB_ITEMS -> Doc
printSymbItems (Symb_items xs :: [SYMB]
xs _) = [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SYMB -> Doc) -> [SYMB] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SYMB -> Doc
forall a. Pretty a => a -> Doc
pretty [SYMB]
xs

printSymbOrMap :: SYMB_OR_MAP -> Doc
printSymbOrMap :: SYMB_OR_MAP -> Doc
printSymbOrMap (Symb sym :: SYMB
sym) = SYMB -> Doc
forall a. Pretty a => a -> Doc
pretty SYMB
sym
printSymbOrMap (Symb_map source :: SYMB
source dest :: SYMB
dest _) =
  SYMB -> Doc
forall a. Pretty a => a -> Doc
pretty SYMB
source Doc -> Doc -> Doc
<+> Doc
mapsto Doc -> Doc -> Doc
<+> SYMB -> Doc
forall a. Pretty a => a -> Doc
pretty SYMB
dest

printSymbMapItems :: SYMB_MAP_ITEMS -> Doc
printSymbMapItems :: SYMB_MAP_ITEMS -> Doc
printSymbMapItems (Symb_map_items xs :: [SYMB_OR_MAP]
xs _) = [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SYMB_OR_MAP -> Doc) -> [SYMB_OR_MAP] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SYMB_OR_MAP -> Doc
forall a. Pretty a => a -> Doc
pretty [SYMB_OR_MAP]
xs


-- Instances for GetRange

instance GetRange OP_ITEM where
  getRange :: OP_ITEM -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (OP_ITEM -> [Pos]) -> OP_ITEM -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OP_ITEM -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: OP_ITEM -> [Pos]
rangeSpan x :: OP_ITEM
x = case OP_ITEM
x of
    Op_item a :: [Token]
a b :: Range
b -> [[Pos]] -> [Pos]
joinRanges [[Token] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [Token]
a, Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
b]

instance GetRange VAR_ITEM where
  getRange :: VAR_ITEM -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (VAR_ITEM -> [Pos]) -> VAR_ITEM -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VAR_ITEM -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: VAR_ITEM -> [Pos]
rangeSpan x :: VAR_ITEM
x = case VAR_ITEM
x of
    Var_item a :: [Token]
a _ b :: Range
b -> [[Pos]] -> [Pos]
joinRanges [[Token] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [Token]
a, Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
b]


instance GetRange BASIC_SPEC where
  getRange :: BASIC_SPEC -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (BASIC_SPEC -> [Pos]) -> BASIC_SPEC -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BASIC_SPEC -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: BASIC_SPEC -> [Pos]
rangeSpan x :: BASIC_SPEC
x = case BASIC_SPEC
x of
    Basic_spec a :: [Annoted BASIC_ITEM]
a -> [[Pos]] -> [Pos]
joinRanges [[Annoted BASIC_ITEM] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [Annoted BASIC_ITEM]
a]

instance GetRange BASIC_ITEM where
  getRange :: BASIC_ITEM -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (BASIC_ITEM -> [Pos]) -> BASIC_ITEM -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BASIC_ITEM -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: BASIC_ITEM -> [Pos]
rangeSpan x :: BASIC_ITEM
x = case BASIC_ITEM
x of
    Op_decl a :: OP_ITEM
a -> [[Pos]] -> [Pos]
joinRanges [OP_ITEM -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan OP_ITEM
a]
    Var_decls a :: [VAR_ITEM]
a -> [[Pos]] -> [Pos]
joinRanges [[VAR_ITEM] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [VAR_ITEM]
a]
    Axiom_item a :: Annoted CMD
a -> [[Pos]] -> [Pos]
joinRanges [Annoted CMD -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Annoted CMD
a]
    EP_decl a :: [(Token, EPDomain)]
a -> [[Pos]] -> [Pos]
joinRanges [[Token] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan ([Token] -> [Pos]) -> [Token] -> [Pos]
forall a b. (a -> b) -> a -> b
$ ((Token, EPDomain) -> Token) -> [(Token, EPDomain)] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (Token, EPDomain) -> Token
forall a b. (a, b) -> a
fst [(Token, EPDomain)]
a]
    EP_domdecl a :: [(Token, APInt)]
a -> [[Pos]] -> [Pos]
joinRanges [[Token] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan ([Token] -> [Pos]) -> [Token] -> [Pos]
forall a b. (a -> b) -> a -> b
$ ((Token, APInt) -> Token) -> [(Token, APInt)] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (Token, APInt) -> Token
forall a b. (a, b) -> a
fst [(Token, APInt)]
a]
    EP_defval a :: [(Token, APInt)]
a -> [[Pos]] -> [Pos]
joinRanges [[Token] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan ([Token] -> [Pos]) -> [Token] -> [Pos]
forall a b. (a -> b) -> a -> b
$ ((Token, APInt) -> Token) -> [(Token, APInt)] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (Token, APInt) -> Token
forall a b. (a, b) -> a
fst [(Token, APInt)]
a]


instance GetRange CMD where
    getRange :: CMD -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (CMD -> [Pos]) -> CMD -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMD -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
    rangeSpan :: CMD -> [Pos]
rangeSpan (Ass _ def :: EXPRESSION
def) = EXPRESSION -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan EXPRESSION
def
    rangeSpan (Cmd _ exps :: [EXPRESSION]
exps) = [[Pos]] -> [Pos]
joinRanges ((EXPRESSION -> [Pos]) -> [EXPRESSION] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map EXPRESSION -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [EXPRESSION]
exps)
    -- parsing guruantees l <> null
    rangeSpan (Repeat c :: EXPRESSION
c l :: [CMD]
l) = [[Pos]] -> [Pos]
joinRanges [EXPRESSION -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan EXPRESSION
c, CMD -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan (CMD -> [Pos]) -> CMD -> [Pos]
forall a b. (a -> b) -> a -> b
$ [CMD] -> CMD
forall a. [a] -> a
head [CMD]
l]
    -- parsing guruantees l <> null
    rangeSpan (Sequence l :: [CMD]
l) = CMD -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan (CMD -> [Pos]) -> CMD -> [Pos]
forall a b. (a -> b) -> a -> b
$ [CMD] -> CMD
forall a. [a] -> a
head [CMD]
l
    rangeSpan (Cond l :: [(EXPRESSION, [CMD])]
l) = (EXPRESSION, [CMD]) -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan ((EXPRESSION, [CMD]) -> [Pos]) -> (EXPRESSION, [CMD]) -> [Pos]
forall a b. (a -> b) -> a -> b
$ [(EXPRESSION, [CMD])] -> (EXPRESSION, [CMD])
forall a. [a] -> a
head [(EXPRESSION, [CMD])]
l

instance GetRange SYMB_ITEMS where
  getRange :: SYMB_ITEMS -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (SYMB_ITEMS -> [Pos]) -> SYMB_ITEMS -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SYMB_ITEMS -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: SYMB_ITEMS -> [Pos]
rangeSpan (Symb_items a :: [SYMB]
a b :: Range
b) = [[Pos]] -> [Pos]
joinRanges [[SYMB] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [SYMB]
a, Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
b]

instance GetRange SYMB where
  getRange :: SYMB -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (SYMB -> [Pos]) -> SYMB -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SYMB -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: SYMB -> [Pos]
rangeSpan (Symb_id a :: Token
a) = [[Pos]] -> [Pos]
joinRanges [Token -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Token
a]


instance GetRange SYMB_MAP_ITEMS where
  getRange :: SYMB_MAP_ITEMS -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range)
-> (SYMB_MAP_ITEMS -> [Pos]) -> SYMB_MAP_ITEMS -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SYMB_MAP_ITEMS -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: SYMB_MAP_ITEMS -> [Pos]
rangeSpan (Symb_map_items a :: [SYMB_OR_MAP]
a b :: Range
b) = [[Pos]] -> [Pos]
joinRanges [[SYMB_OR_MAP] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [SYMB_OR_MAP]
a, Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
b]

instance GetRange SYMB_OR_MAP where
  getRange :: SYMB_OR_MAP -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (SYMB_OR_MAP -> [Pos]) -> SYMB_OR_MAP -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SYMB_OR_MAP -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: SYMB_OR_MAP -> [Pos]
rangeSpan x :: SYMB_OR_MAP
x = case SYMB_OR_MAP
x of
    Symb a :: SYMB
a -> [[Pos]] -> [Pos]
joinRanges [SYMB -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan SYMB
a]
    Symb_map a :: SYMB
a b :: SYMB
b c :: Range
c -> [[Pos]] -> [Pos]
joinRanges [SYMB -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan SYMB
a, SYMB -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan SYMB
b, Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
c]

instance GetRange EXPRESSION where
  getRange :: EXPRESSION -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (EXPRESSION -> [Pos]) -> EXPRESSION -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EXPRESSION -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan
  rangeSpan :: EXPRESSION -> [Pos]
rangeSpan x :: EXPRESSION
x = case EXPRESSION
x of
    Var token :: Token
token -> [[Pos]] -> [Pos]
joinRanges [Token -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Token
token]
    Op _ _ exps :: [EXPRESSION]
exps a :: Range
a -> [[Pos]] -> [Pos]
joinRanges ([[Pos]] -> [Pos]) -> [[Pos]] -> [Pos]
forall a b. (a -> b) -> a -> b
$ Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
a [Pos] -> [[Pos]] -> [[Pos]]
forall a. a -> [a] -> [a]
: (EXPRESSION -> [Pos]) -> [EXPRESSION] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map EXPRESSION -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [EXPRESSION]
exps
    List exps :: [EXPRESSION]
exps a :: Range
a -> [[Pos]] -> [Pos]
joinRanges ([[Pos]] -> [Pos]) -> [[Pos]] -> [Pos]
forall a b. (a -> b) -> a -> b
$ Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
a [Pos] -> [[Pos]] -> [[Pos]]
forall a. a -> [a] -> [a]
: (EXPRESSION -> [Pos]) -> [EXPRESSION] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map EXPRESSION -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [EXPRESSION]
exps
    Int _ a :: Range
a -> [[Pos]] -> [Pos]
joinRanges [Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
a]
    Rat _ a :: Range
a -> [[Pos]] -> [Pos]
joinRanges [Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
a]
    Interval _ _ a :: Range
a -> [[Pos]] -> [Pos]
joinRanges [Range -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Range
a]


instance Pretty InstantiatedConstant where
    pretty :: InstantiatedConstant -> Doc
pretty (InstantiatedConstant { constName :: InstantiatedConstant -> ConstantName
constName = ConstantName
cn, instantiation :: InstantiatedConstant -> [EXPRESSION]
instantiation = [EXPRESSION]
el }) =
        if [EXPRESSION] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EXPRESSION]
el then ConstantName -> Doc
forall a. Pretty a => a -> Doc
pretty ConstantName
cn
        else ConstantName -> Doc
forall a. Pretty a => a -> Doc
pretty ConstantName
cn Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
sepByCommas ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (EXPRESSION -> Doc) -> [EXPRESSION] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map EXPRESSION -> Doc
forall a. Pretty a => a -> Doc
pretty [EXPRESSION]
el)