-- |
-- Module      :  Cryptol.Utils.Fixity
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE Safe #-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Cryptol.Utils.Fixity
  ( Assoc(..)
  , Fixity(..)
  , defaultFixity
  , FixityCmp(..)
  , compareFixity
  ) where

import GHC.Generics (Generic)
import Control.DeepSeq

-- | Information about associativity.
data Assoc = LeftAssoc | RightAssoc | NonAssoc
  deriving (Int -> Assoc -> ShowS
[Assoc] -> ShowS
Assoc -> String
(Int -> Assoc -> ShowS)
-> (Assoc -> String) -> ([Assoc] -> ShowS) -> Show Assoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assoc] -> ShowS
$cshowList :: [Assoc] -> ShowS
show :: Assoc -> String
$cshow :: Assoc -> String
showsPrec :: Int -> Assoc -> ShowS
$cshowsPrec :: Int -> Assoc -> ShowS
Show, Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c== :: Assoc -> Assoc -> Bool
Eq, (forall x. Assoc -> Rep Assoc x)
-> (forall x. Rep Assoc x -> Assoc) -> Generic Assoc
forall x. Rep Assoc x -> Assoc
forall x. Assoc -> Rep Assoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Assoc x -> Assoc
$cfrom :: forall x. Assoc -> Rep Assoc x
Generic, Assoc -> ()
(Assoc -> ()) -> NFData Assoc
forall a. (a -> ()) -> NFData a
rnf :: Assoc -> ()
$crnf :: Assoc -> ()
NFData)

data Fixity = Fixity { Fixity -> Assoc
fAssoc :: !Assoc, Fixity -> Int
fLevel :: !Int }
  deriving (Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: Fixity -> Fixity -> Bool
Eq, (forall x. Fixity -> Rep Fixity x)
-> (forall x. Rep Fixity x -> Fixity) -> Generic Fixity
forall x. Rep Fixity x -> Fixity
forall x. Fixity -> Rep Fixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fixity x -> Fixity
$cfrom :: forall x. Fixity -> Rep Fixity x
Generic, Fixity -> ()
(Fixity -> ()) -> NFData Fixity
forall a. (a -> ()) -> NFData a
rnf :: Fixity -> ()
$crnf :: Fixity -> ()
NFData, Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show)

data FixityCmp = FCError
               | FCLeft
               | FCRight
                 deriving (Int -> FixityCmp -> ShowS
[FixityCmp] -> ShowS
FixityCmp -> String
(Int -> FixityCmp -> ShowS)
-> (FixityCmp -> String)
-> ([FixityCmp] -> ShowS)
-> Show FixityCmp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityCmp] -> ShowS
$cshowList :: [FixityCmp] -> ShowS
show :: FixityCmp -> String
$cshow :: FixityCmp -> String
showsPrec :: Int -> FixityCmp -> ShowS
$cshowsPrec :: Int -> FixityCmp -> ShowS
Show, FixityCmp -> FixityCmp -> Bool
(FixityCmp -> FixityCmp -> Bool)
-> (FixityCmp -> FixityCmp -> Bool) -> Eq FixityCmp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityCmp -> FixityCmp -> Bool
$c/= :: FixityCmp -> FixityCmp -> Bool
== :: FixityCmp -> FixityCmp -> Bool
$c== :: FixityCmp -> FixityCmp -> Bool
Eq)

-- | Let @op1@ have fixity @f1@ and @op2@ have fixity @f2. Then
-- @compareFixity f1 f2@ determines how to parse the infix expression
-- @x op1 y op2 z@.
--
-- * @FCLeft@: @(x op1 y) op2 z@
-- * @FCRight@: @x op1 (y op2 z)@
-- * @FCError@: no parse
compareFixity :: Fixity -> Fixity -> FixityCmp
compareFixity :: Fixity -> Fixity -> FixityCmp
compareFixity (Fixity Assoc
a1 Int
p1) (Fixity Assoc
a2 Int
p2) =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
p1 Int
p2 of
    Ordering
GT -> FixityCmp
FCLeft
    Ordering
LT -> FixityCmp
FCRight
    Ordering
EQ -> case (Assoc
a1, Assoc
a2) of
            (Assoc
LeftAssoc, Assoc
LeftAssoc)   -> FixityCmp
FCLeft
            (Assoc
RightAssoc, Assoc
RightAssoc) -> FixityCmp
FCRight
            (Assoc, Assoc)
_                        -> FixityCmp
FCError

-- | The fixity used when none is provided.
defaultFixity :: Fixity
defaultFixity :: Fixity
defaultFixity = Assoc -> Int -> Fixity
Fixity Assoc
LeftAssoc Int
100