HsAssoc.hs

-- $Id: HsAssoc.hs,v 1.8 2001/10/10 23:36:06 hallgren Exp $

module HsAssoc where
import Maybe(fromMaybe)

-- Formerly known as InfixAssoc...
data HsFixity = HsFixity HsAssoc Int deriving (Eq,Show)

data HsAssoc
    = HsAssocNone
    | HsAssocLeft
    | HsAssocRight
      deriving (Eq, Show)

class InfixEnv i env | env->i where
    extend :: env -> (i,HsFixity) -> env
    extend2 :: env -> env -> env
    defaultOps :: env -> [i] -> env
    lookUp :: env -> i -> Maybe HsFixity
      
newtype OperatorEnv i = OperatorEnv [(i,HsFixity)] deriving (Show)

unOE (OperatorEnv e) = e
emptyOE = OperatorEnv []

instance Eq i => InfixEnv i (OperatorEnv i) where
    extend (OperatorEnv env) i = OperatorEnv (i: env)
    extend2 (OperatorEnv env1) (OperatorEnv env2) = OperatorEnv (env2++env1)
    defaultOps (OperatorEnv env) ns =
      OperatorEnv [f|f@(i,_)<-env,i `notElem` ns]
    lookUp (OperatorEnv env) n = lookup n env

getFixity env = fromMaybe defaultFixity . lookUp env 
defaultFixity = HsFixity HsAssocLeft 9
          
getPrec env name  =
    case (lookUp env name) of 
      Just (HsFixity a p) -> p
      Nothing            -> 9 -- See the Report, section 4.4.2

getAssoc env name =
    case lookUp env name of 
      Just (HsFixity a p)  -> a
      Nothing             -> HsAssocLeft -- See the Report, section 4.4.2