-- |
-- 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
$cshowsPrec :: Int -> Assoc -> ShowS
showsPrec :: Int -> Assoc -> ShowS
$cshow :: Assoc -> String
show :: Assoc -> String
$cshowList :: [Assoc] -> ShowS
showList :: [Assoc] -> ShowS
Show, Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
/= :: Assoc -> Assoc -> Bool
Eq, Eq Assoc
Eq Assoc =>
(Assoc -> Assoc -> Ordering)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Assoc)
-> (Assoc -> Assoc -> Assoc)
-> Ord Assoc
Assoc -> Assoc -> Bool
Assoc -> Assoc -> Ordering
Assoc -> Assoc -> Assoc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Assoc -> Assoc -> Ordering
compare :: Assoc -> Assoc -> Ordering
$c< :: Assoc -> Assoc -> Bool
< :: Assoc -> Assoc -> Bool
$c<= :: Assoc -> Assoc -> Bool
<= :: Assoc -> Assoc -> Bool
$c> :: Assoc -> Assoc -> Bool
> :: Assoc -> Assoc -> Bool
$c>= :: Assoc -> Assoc -> Bool
>= :: Assoc -> Assoc -> Bool
$cmax :: Assoc -> Assoc -> Assoc
max :: Assoc -> Assoc -> Assoc
$cmin :: Assoc -> Assoc -> Assoc
min :: Assoc -> Assoc -> Assoc
Ord, (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
$cfrom :: forall x. Assoc -> Rep Assoc x
from :: forall x. Assoc -> Rep Assoc x
$cto :: forall x. Rep Assoc x -> Assoc
to :: forall x. Rep Assoc x -> Assoc
Generic, Assoc -> ()
(Assoc -> ()) -> NFData Assoc
forall a. (a -> ()) -> NFData a
$crnf :: Assoc -> ()
rnf :: 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
$c== :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
/= :: Fixity -> Fixity -> Bool
Eq, Eq Fixity
Eq Fixity =>
(Fixity -> Fixity -> Ordering)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Fixity)
-> (Fixity -> Fixity -> Fixity)
-> Ord Fixity
Fixity -> Fixity -> Bool
Fixity -> Fixity -> Ordering
Fixity -> Fixity -> Fixity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Fixity -> Fixity -> Ordering
compare :: Fixity -> Fixity -> Ordering
$c< :: Fixity -> Fixity -> Bool
< :: Fixity -> Fixity -> Bool
$c<= :: Fixity -> Fixity -> Bool
<= :: Fixity -> Fixity -> Bool
$c> :: Fixity -> Fixity -> Bool
> :: Fixity -> Fixity -> Bool
$c>= :: Fixity -> Fixity -> Bool
>= :: Fixity -> Fixity -> Bool
$cmax :: Fixity -> Fixity -> Fixity
max :: Fixity -> Fixity -> Fixity
$cmin :: Fixity -> Fixity -> Fixity
min :: Fixity -> Fixity -> Fixity
Ord, (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
$cfrom :: forall x. Fixity -> Rep Fixity x
from :: forall x. Fixity -> Rep Fixity x
$cto :: forall x. Rep Fixity x -> Fixity
to :: forall x. Rep Fixity x -> Fixity
Generic, Fixity -> ()
(Fixity -> ()) -> NFData Fixity
forall a. (a -> ()) -> NFData a
$crnf :: Fixity -> ()
rnf :: 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
$cshowsPrec :: Int -> Fixity -> ShowS
showsPrec :: Int -> Fixity -> ShowS
$cshow :: Fixity -> String
show :: Fixity -> String
$cshowList :: [Fixity] -> ShowS
showList :: [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
$cshowsPrec :: Int -> FixityCmp -> ShowS
showsPrec :: Int -> FixityCmp -> ShowS
$cshow :: FixityCmp -> String
show :: FixityCmp -> String
$cshowList :: [FixityCmp] -> ShowS
showList :: [FixityCmp] -> ShowS
Show, FixityCmp -> FixityCmp -> Bool
(FixityCmp -> FixityCmp -> Bool)
-> (FixityCmp -> FixityCmp -> Bool) -> Eq FixityCmp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityCmp -> FixityCmp -> Bool
== :: FixityCmp -> FixityCmp -> Bool
$c/= :: FixityCmp -> FixityCmp -> Bool
/= :: 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