{- |
    Module      :  $Header$
    Description :  Environment of operator precedences
    Copyright   :  (c) 2002 - 2004, Wolfgang Lux
                       2011 - 2013, Björn Peemöller
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    In order to parse infix expressions correctly, the compiler must know
    the precedence and fixity of each operator. Operator precedences are
    associated with entities and will be checked after renaming was
    applied. Nevertheless, we need to save precedences for ambiguous names
    in order to handle them correctly while computing the exported
    interface of a module.

    If no fixity is assigned to an operator, it will be given the default
    precedence 9 and assumed to be a left-associative operator.

    /Note:/ this modified version uses Haskell type 'Integer'
    for representing the precedence. This change had to be done due to the
    introduction of unlimited integer constants in the parser / lexer.
-}
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

-- |Operator precedence.
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

-- TODO: Change to real show instance and provide Pretty instance
-- if used anywhere.
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

-- |Default operator declaration (associativity and precedence).
defaultP :: OpPrec
defaultP :: OpPrec
defaultP = Infix -> Precedence -> OpPrec
OpPrec Infix
defaultAssoc Precedence
defaultPrecedence

-- |Default operator associativity.
defaultAssoc :: Infix
defaultAssoc :: Infix
defaultAssoc = Infix
InfixL

-- |Default operator precedence.
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

-- |Precedence information for an identifier.
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

-- |Environment mapping identifiers to their operator precedence.
type OpPrecEnv = TopEnv PrecInfo

-- |Initial 'OpPrecEnv'.
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

-- |Precedence of list constructor.
consPrec :: PrecInfo
consPrec :: PrecInfo
consPrec = QualIdent -> OpPrec -> PrecInfo
PrecInfo QualIdent
qConsId (Infix -> Precedence -> OpPrec
OpPrec Infix
InfixR 5)

-- |Bind an operator precedence.
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

-- The lookup functions for the environment which maintains the operator
-- precedences are simpler than for the type and value environments
-- because they do not need to handle tuple constructors.

-- |Lookup the operator precedence for an 'Ident'.
lookupP :: Ident -> OpPrecEnv -> [PrecInfo]
lookupP :: Ident -> OpPrecEnv -> [PrecInfo]
lookupP = Ident -> OpPrecEnv -> [PrecInfo]
forall a. Ident -> TopEnv a -> [a]
lookupTopEnv

-- |Lookup the operator precedence for an 'QualIdent'.
qualLookupP :: QualIdent -> OpPrecEnv -> [PrecInfo]
qualLookupP :: QualIdent -> OpPrecEnv -> [PrecInfo]
qualLookupP = QualIdent -> OpPrecEnv -> [PrecInfo]
forall a. QualIdent -> TopEnv a -> [a]
qualLookupTopEnv