{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{-
Module : $Header$
Description : Operatators
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable ()
-}
module Language.CAO.Common.Operator
( Operator(..)
, Fixity(..)
, Assoc(..)
, pprParens_
, pprParensR_
, pprParensL_
, wrapIfPrec
) where
import Language.CAO.Common.Outputable
data Fixity = Infix | Prefix | Nofix | Postfix
data Assoc = ALeft | ARight | NoAssoc
class Operator o where
isSimple :: o -> Bool
assoc :: o -> Assoc
fixity :: o -> Fixity
prec :: o -> Int
pprParens_ :: (PP o, Operator o, Operator o') => o -> o' -> CDoc
pprParens_ e ctx
| sameAssoc e ctx = ppr e
| otherwise = wrapIfPrec (prec ctx) e
pprParensR_ :: (PP o, Operator o, Operator o') => o -> o' -> CDoc
pprParensR_ e ctx
| isPostfix e = ppr e
| isInfixR e
&& isInfixR ctx
&& prec e == prec ctx = ppr e
| otherwise = wrapIfPrec (prec ctx) e
pprParensL_ :: (PP o, Operator o, Operator o') => o -> o' -> CDoc
pprParensL_ e ctx
| isPostfix e = ppr e
| isInfixL e
&& isInfixL ctx
&& prec e == prec ctx = ppr e
| otherwise = wrapIfPrec (prec ctx) e
wrapIfPrec :: (PP o, Operator o) => Int -> o -> CDoc
wrapIfPrec oprec e
| prec e > oprec = ppr e
| otherwise = parens (ppr e)
sameAssoc :: (Operator o, Operator o') => o -> o' -> Bool
sameAssoc e0 e1
| isSimple e0 = isSimple e1
| isPrefix e0 = isPrefix e1
| isPostfix e0 = isPostfix e1
| isInfixL e0 = isInfixL e1
| isInfixR e0 = isInfixR e1
| otherwise = False
isInfix :: Operator o => o -> Bool
isInfix o = case fixity o of
Infix -> True
_ -> False
isInfixL :: Operator o => o -> Bool
isInfixL o = isInfix o && isAssocL
where
isAssocL = case assoc o of
ALeft -> True
_ -> False
isInfixR :: Operator o => o -> Bool
isInfixR o = isInfix o && isAssocR
where
isAssocR = case assoc o of
ARight -> True
_ -> False
isPrefix :: Operator o => o -> Bool
isPrefix o = case fixity o of
Prefix -> True
_ -> False
isPostfix :: Operator o => o -> Bool
isPostfix o = case fixity o of
Postfix -> True
_ -> False