module Env.OpPrec
( OpPrec (..), defaultP, defaultAssoc, defaultPrecedence, mkPrec
, OpPrecEnv, PrecInfo (..), bindP, lookupP, qualLookupP, initOpPrecEnv
) where
import Curry.Base.Ident
import Curry.Base.Pretty (Pretty(..))
import Curry.Syntax (Infix (..))
import Base.TopEnv
import Data.Maybe (fromMaybe)
import Text.PrettyPrint
data OpPrec = OpPrec Infix Precedence deriving OpPrec -> OpPrec -> Bool
(OpPrec -> OpPrec -> Bool)
-> (OpPrec -> OpPrec -> Bool) -> Eq OpPrec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpPrec -> OpPrec -> Bool
$c/= :: OpPrec -> OpPrec -> Bool
== :: OpPrec -> OpPrec -> Bool
$c== :: OpPrec -> OpPrec -> Bool
Eq
type Precedence = Integer
instance Show OpPrec where
showsPrec :: Int -> OpPrec -> ShowS
showsPrec _ (OpPrec fix :: Infix
fix p :: Precedence
p) = String -> ShowS
showString (Infix -> String
assoc Infix
fix) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precedence -> ShowS
forall a. Show a => a -> ShowS
shows Precedence
p
where
assoc :: Infix -> String
assoc InfixL = "left "
assoc InfixR = "right "
assoc Infix = "non-assoc "
instance Pretty OpPrec where
pPrint :: OpPrec -> Doc
pPrint (OpPrec fix :: Infix
fix p :: Precedence
p) = Infix -> Doc
forall a. Pretty a => a -> Doc
pPrint Infix
fix Doc -> Doc -> Doc
<+> Precedence -> Doc
integer Precedence
p
defaultP :: OpPrec
defaultP :: OpPrec
defaultP = Infix -> Precedence -> OpPrec
OpPrec Infix
defaultAssoc Precedence
defaultPrecedence
defaultAssoc :: Infix
defaultAssoc :: Infix
defaultAssoc = Infix
InfixL
defaultPrecedence :: Precedence
defaultPrecedence :: Precedence
defaultPrecedence = 9
mkPrec :: Maybe Precedence -> Precedence
mkPrec :: Maybe Precedence -> Precedence
mkPrec mprec :: Maybe Precedence
mprec = Precedence -> Maybe Precedence -> Precedence
forall a. a -> Maybe a -> a
fromMaybe Precedence
defaultPrecedence Maybe Precedence
mprec
data PrecInfo = PrecInfo QualIdent OpPrec deriving (PrecInfo -> PrecInfo -> Bool
(PrecInfo -> PrecInfo -> Bool)
-> (PrecInfo -> PrecInfo -> Bool) -> Eq PrecInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrecInfo -> PrecInfo -> Bool
$c/= :: PrecInfo -> PrecInfo -> Bool
== :: PrecInfo -> PrecInfo -> Bool
$c== :: PrecInfo -> PrecInfo -> Bool
Eq, Int -> PrecInfo -> ShowS
[PrecInfo] -> ShowS
PrecInfo -> String
(Int -> PrecInfo -> ShowS)
-> (PrecInfo -> String) -> ([PrecInfo] -> ShowS) -> Show PrecInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrecInfo] -> ShowS
$cshowList :: [PrecInfo] -> ShowS
show :: PrecInfo -> String
$cshow :: PrecInfo -> String
showsPrec :: Int -> PrecInfo -> ShowS
$cshowsPrec :: Int -> PrecInfo -> ShowS
Show)
instance Entity PrecInfo where
origName :: PrecInfo -> QualIdent
origName (PrecInfo op :: QualIdent
op _) = QualIdent
op
instance Pretty PrecInfo where
pPrint :: PrecInfo -> Doc
pPrint (PrecInfo qid :: QualIdent
qid prec :: OpPrec
prec) = QualIdent -> Doc
forall a. Pretty a => a -> Doc
pPrint QualIdent
qid Doc -> Doc -> Doc
<+> OpPrec -> Doc
forall a. Pretty a => a -> Doc
pPrint OpPrec
prec
type OpPrecEnv = TopEnv PrecInfo
initOpPrecEnv :: OpPrecEnv
initOpPrecEnv :: OpPrecEnv
initOpPrecEnv = QualIdent -> PrecInfo -> OpPrecEnv -> OpPrecEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
predefTopEnv QualIdent
qConsId PrecInfo
consPrec OpPrecEnv
forall a. TopEnv a
emptyTopEnv
consPrec :: PrecInfo
consPrec :: PrecInfo
consPrec = QualIdent -> OpPrec -> PrecInfo
PrecInfo QualIdent
qConsId (Infix -> Precedence -> OpPrec
OpPrec Infix
InfixR 5)
bindP :: ModuleIdent -> Ident -> OpPrec -> OpPrecEnv -> OpPrecEnv
bindP :: ModuleIdent -> Ident -> OpPrec -> OpPrecEnv -> OpPrecEnv
bindP m :: ModuleIdent
m op :: Ident
op p :: OpPrec
p
| Ident -> Bool
hasGlobalScope Ident
op = Ident -> PrecInfo -> OpPrecEnv -> OpPrecEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
op PrecInfo
info (OpPrecEnv -> OpPrecEnv)
-> (OpPrecEnv -> OpPrecEnv) -> OpPrecEnv -> OpPrecEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> PrecInfo -> OpPrecEnv -> OpPrecEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
qop PrecInfo
info
| Bool
otherwise = Ident -> PrecInfo -> OpPrecEnv -> OpPrecEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
op PrecInfo
info
where qop :: QualIdent
qop = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
op
info :: PrecInfo
info = QualIdent -> OpPrec -> PrecInfo
PrecInfo QualIdent
qop OpPrec
p
lookupP :: Ident -> OpPrecEnv -> [PrecInfo]
lookupP :: Ident -> OpPrecEnv -> [PrecInfo]
lookupP = Ident -> OpPrecEnv -> [PrecInfo]
forall a. Ident -> TopEnv a -> [a]
lookupTopEnv
qualLookupP :: QualIdent -> OpPrecEnv -> [PrecInfo]
qualLookupP :: QualIdent -> OpPrecEnv -> [PrecInfo]
qualLookupP = QualIdent -> OpPrecEnv -> [PrecInfo]
forall a. QualIdent -> TopEnv a -> [a]
qualLookupTopEnv