{-# language InstanceSigs, ScopedTypeVariables, TypeApplications #-} {-# language LambdaCase #-} {-# language MultiParamTypeClasses, FlexibleInstances #-} {-# language DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric #-} {-# language TemplateHaskell #-} {-| Module : Language.Python.Syntax.Operator.Binary Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : Isaac Elliott Stability : experimental Portability : non-portable This module contains a datatype for binary operators and a precedence table with associated operations. This presentation of operators is simpler and more flexible than hard-coding them into the syntax tree. -} module Language.Python.Syntax.Operator.Binary where import Control.Lens.Getter ((^.)) import Control.Lens.Lens (Lens', lens) import Control.Lens.TH (makeLenses) import Data.Functor (($>)) import Data.Generics.Product.Typed (typed) import Data.Semigroup ((<>)) import GHC.Generics (Generic) import Language.Python.Syntax.Ann import Language.Python.Syntax.Whitespace -- | A Python binary operator, such as @+@, along with its trailing 'Whitespace' data BinOp a -- | @a is b@ = Is (Ann a) [Whitespace] -- | @a is not b@ | IsNot (Ann a) [Whitespace] [Whitespace] -- | @a in b@ | In (Ann a) [Whitespace] -- | @a not in b@ | NotIn (Ann a) [Whitespace] [Whitespace] -- | @a - b@ | Minus (Ann a) [Whitespace] -- | @a ** b@ | Exp (Ann a) [Whitespace] -- | @a and b@ | BoolAnd (Ann a) [Whitespace] -- | @a or b@ | BoolOr (Ann a) [Whitespace] -- | @a == b@ | Eq (Ann a) [Whitespace] -- | @a < b@ | Lt (Ann a) [Whitespace] -- | @a <= b@ | LtEq (Ann a) [Whitespace] -- | @a > b@ | Gt (Ann a) [Whitespace] -- | @a >= b@ | GtEq (Ann a) [Whitespace] -- | @a != b@ | NotEq (Ann a) [Whitespace] -- | @a * b@ | Multiply (Ann a) [Whitespace] -- | @a / b@ | Divide (Ann a) [Whitespace] -- | @a // b@ | FloorDivide (Ann a) [Whitespace] -- | @a % b@ | Percent (Ann a) [Whitespace] -- | @a + b@ | Plus (Ann a) [Whitespace] -- | @a | b@ | BitOr (Ann a) [Whitespace] -- | @a ^ b@ | BitXor (Ann a) [Whitespace] -- | @a & b@ | BitAnd (Ann a) [Whitespace] -- | @a << b@ | ShiftLeft (Ann a) [Whitespace] -- | @a >> b@ | ShiftRight (Ann a) [Whitespace] -- | @a @ b@ | At (Ann a) [Whitespace] deriving (Eq, Show, Functor, Foldable, Traversable, Generic) instance HasAnn BinOp where annot :: forall a. Lens' (BinOp a) (Ann a) annot = typed @(Ann a) instance HasTrailingWhitespace (BinOp a) where trailingWhitespace = lens (\case Is _ a -> a IsNot _ _ a -> a In _ a -> a NotIn _ _ a -> a Minus _ a -> a Exp _ a -> a BoolAnd _ a -> a BoolOr _ a -> a Multiply _ a -> a Divide _ a -> a FloorDivide _ a -> a Plus _ a -> a Eq _ a -> a Lt _ a -> a LtEq _ a -> a Gt _ a -> a GtEq _ a -> a NotEq _ a -> a BitOr _ a -> a BitXor _ a -> a BitAnd _ a -> a ShiftLeft _ a -> a ShiftRight _ a -> a Percent _ a -> a At _ a -> a) (\op ws -> case op of Is a _ -> Is a ws IsNot a b _ -> IsNot a b ws In a _ -> In a ws NotIn a b _ -> NotIn a b ws Minus a _ -> Minus a ws Exp a _ -> Exp a ws BoolAnd a _ -> BoolAnd a ws BoolOr a _ -> BoolOr a ws Multiply a _ -> Multiply a ws Divide a _ -> Divide a ws FloorDivide a _ -> FloorDivide a ws Plus a _ -> Plus a ws Eq a _ -> Eq a ws Lt a _ -> Lt a ws LtEq a _ -> LtEq a ws Gt a _ -> Gt a ws GtEq a _ -> GtEq a ws NotEq a _ -> NotEq a ws BitOr a _ -> BitOr a ws BitAnd a _ -> BitAnd a ws BitXor a _ -> BitXor a ws ShiftLeft a _ -> ShiftLeft a ws ShiftRight a _ -> ShiftRight a ws Percent a _ -> Eq a ws At a _ -> At a ws) -- | The associativity of an operator. Each operator is either left-associative or right associative. -- -- Left associative: -- -- @ -- x + y + z = (x + y) + z -- @ -- -- Right associative: -- -- @ -- x + y + z = x + (y + z) -- @ data Assoc = L | R deriving (Eq, Show) -- | An operator along with its precedence and associativity. data OpEntry = OpEntry { _opOperator :: BinOp () , _opPrec :: Int , _opAssoc :: Assoc } makeLenses ''OpEntry -- | 'operatorTable' is a list of all operators in ascending order of precedence. operatorTable :: [OpEntry] operatorTable = [ entry BoolOr 4 L , entry BoolAnd 5 L , entry Is 10 L , entry1 IsNot 10 L , entry In 10 L , entry1 NotIn 10 L , entry Eq 10 L , entry Lt 10 L , entry LtEq 10 L , entry Gt 10 L , entry GtEq 10 L , entry NotEq 10 L , entry BitOr 14 L , entry BitXor 15 L , entry BitAnd 16 L , entry ShiftLeft 17 L , entry ShiftRight 17 L , entry Minus 20 L , entry Plus 20 L , entry Multiply 25 L , entry At 25 L , entry Divide 25 L , entry FloorDivide 25 L , entry Percent 25 L , entry Exp 30 R ] where entry a = OpEntry (a (Ann ()) []) entry1 a = OpEntry (a (Ann ()) [] []) -- | Compare two 'BinOp's to determine whether they represent the same operator, ignoring annotations and trailing whitespace. sameOperator :: BinOp a -> BinOp a' -> Bool sameOperator op op' = case (op, op') of (BoolOr{}, BoolOr{}) -> True (BoolAnd{}, BoolAnd{}) -> True (Is{}, Is{}) -> True (IsNot{}, IsNot{}) -> True (In{}, In{}) -> True (NotIn{}, NotIn{}) -> True (Eq{}, Eq{}) -> True (Lt{}, Lt{}) -> True (LtEq{}, LtEq{}) -> True (Gt{}, Gt{}) -> True (GtEq{}, GtEq{}) -> True (NotEq{}, NotEq{}) -> True (Minus{}, Minus{}) -> True (Plus{}, Plus{}) -> True (Multiply{}, Multiply{}) -> True (Divide{}, Divide{}) -> True (FloorDivide{}, FloorDivide{}) -> True (Exp{}, Exp{}) -> True (Percent{}, Percent{}) -> True (BitOr{}, BitOr{}) -> True (BitXor{}, BitXor{}) -> True (BitAnd{}, BitAnd{}) -> True (ShiftLeft{}, ShiftLeft{}) -> True (ShiftRight{}, ShiftRight{}) -> True (At{}, At{}) -> True _ -> False -- | Is a 'BinOp' a comparison, such as @<=@ isComparison :: BinOp a -> Bool isComparison a = case a of Is{} -> True IsNot{} -> True In{} -> True NotIn{} -> True Eq{} -> True Lt{} -> True LtEq{} -> True Gt{} -> True GtEq{} -> True NotEq{} -> True _ -> False -- | Retrieve the information for a given operator from the operator table. lookupOpEntry :: BinOp a -> [OpEntry] -> OpEntry lookupOpEntry op = go (op $> ()) where go op [] = error $ show op <> " not found in operator table" go op (x:xs) | sameOperator (x ^. opOperator) op = x | otherwise = go op xs