--------------------------------------------------------------------
-- |
-- Copyright :  © Edward Kmett 2010-2014, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ersatz.Internal.Literal
  ( Literal(..)
  , negateLiteral
  , literalFalse, literalTrue
  ) where

-- | A naked possibly-negated Atom, present in the target 'Ersatz.Solver.Solver'.
--
-- The literals @-1@ and @1@ are dedicated for the constant 'False' and the
-- constant 'True' respectively.
newtype Literal = Literal { Literal -> Int
literalId :: Int } deriving (Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq,Eq Literal
Eq Literal
-> (Literal -> Literal -> Ordering)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Literal)
-> (Literal -> Literal -> Literal)
-> Ord Literal
Literal -> Literal -> Bool
Literal -> Literal -> Ordering
Literal -> Literal -> Literal
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
min :: Literal -> Literal -> Literal
$cmin :: Literal -> Literal -> Literal
max :: Literal -> Literal -> Literal
$cmax :: Literal -> Literal -> Literal
>= :: Literal -> Literal -> Bool
$c>= :: Literal -> Literal -> Bool
> :: Literal -> Literal -> Bool
$c> :: Literal -> Literal -> Bool
<= :: Literal -> Literal -> Bool
$c<= :: Literal -> Literal -> Bool
< :: Literal -> Literal -> Bool
$c< :: Literal -> Literal -> Bool
compare :: Literal -> Literal -> Ordering
$ccompare :: Literal -> Literal -> Ordering
$cp1Ord :: Eq Literal
Ord)

instance Show Literal where
  showsPrec :: Int -> Literal -> ShowS
showsPrec Int
i = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i (Int -> ShowS) -> (Literal -> Int) -> Literal -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Int
literalId
  show :: Literal -> String
show = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Literal -> Int) -> Literal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Int
literalId
  showList :: [Literal] -> ShowS
showList = [Int] -> ShowS
forall a. Show a => [a] -> ShowS
showList ([Int] -> ShowS) -> ([Literal] -> [Int]) -> [Literal] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Literal -> Int) -> [Literal] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Literal -> Int
literalId

negateLiteral :: Literal -> Literal
negateLiteral :: Literal -> Literal
negateLiteral = Int -> Literal
Literal (Int -> Literal) -> (Literal -> Int) -> Literal -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Literal -> Int) -> Literal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Int
literalId

-- | The 'False' constant. The literal @-1@ is dedicated for it.
literalFalse :: Literal
literalFalse :: Literal
literalFalse = Int -> Literal
Literal (-Int
1)

-- | The 'True' constant. The literal @1@ is dedicated for it.
literalTrue :: Literal
literalTrue :: Literal
literalTrue = Int -> Literal
Literal Int
1