Operator.hs

{-  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 <http://www.gnu.org/licenses/>. -}

{-
Module      :  $Header$
Description :  Operatators
Copyright   :  (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License     :  GPL
 
Maintainer  :  Paulo Silva <paufil@di.uminho.pt>
Stability   :  experimental
Portability :  non-portable (<reason>)

-}

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