-- |
-- Module      :  Cryptol.Parser.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.Parser.Fixity
  ( Fixity(..)
  , defaultFixity
  , FixityCmp(..)
  , compareFixity
  ) where

import Cryptol.Utils.PP

import GHC.Generics (Generic)
import Control.DeepSeq

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)

compareFixity :: Fixity -> Fixity -> FixityCmp
compareFixity :: Fixity -> Fixity -> FixityCmp
compareFixity (Fixity a1 :: Assoc
a1 p1 :: Int
p1) (Fixity a2 :: Assoc
a2 p2 :: Int
p2) =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
p1 Int
p2 of
    GT -> FixityCmp
FCLeft
    LT -> FixityCmp
FCRight
    EQ -> case (Assoc
a1, Assoc
a2) of
            (LeftAssoc, LeftAssoc)   -> FixityCmp
FCLeft
            (RightAssoc, RightAssoc) -> FixityCmp
FCRight
            _                        -> FixityCmp
FCError

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

instance PP Fixity where
  ppPrec :: Int -> Fixity -> Doc
ppPrec _ (Fixity assoc :: Assoc
assoc level :: Int
level) =
    String -> Doc
text "precedence" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
level Doc -> Doc -> Doc
<.> Doc
comma Doc -> Doc -> Doc
<+> Assoc -> Doc
forall a. PP a => a -> Doc
pp Assoc
assoc