{-# LANGUAGE DeriveGeneric #-}

module Generic.Instruction (GenericInstruction(..)) where

import           Generic.Operand (GenericOperand)
import           GHC.Generics (Generic)
import qualified Data.Serialize as Cereal
import           Data.List (intercalate)
import           Control.DeepSeq

-- | A generic instruction
data GenericInstruction label storage prefix opcode annotation =
  Instruction { GenericInstruction label storage prefix opcode annotation -> label
label :: label                         -- ^ unique identifier of the instruction: can be an immediate address, or a string label
              , GenericInstruction label storage prefix opcode annotation
-> Maybe prefix
prefix :: Maybe prefix                 -- ^ optional: prefix, e.g., lock or repz
              , GenericInstruction label storage prefix opcode annotation -> opcode
opcode :: opcode                       -- ^ opcode/mnemonic
              , GenericInstruction label storage prefix opcode annotation
-> Maybe (GenericOperand storage)
dest :: Maybe (GenericOperand storage) -- ^ destination operand, possibly none
              , GenericInstruction label storage prefix opcode annotation
-> [GenericOperand storage]
srcs :: [GenericOperand storage]       -- ^ source operands, possibly empty
              , GenericInstruction label storage prefix opcode annotation
-> Maybe annotation
annot :: Maybe annotation              -- ^ optional: an annotation, such as the instruction size
              }
  deriving (GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
(GenericInstruction label storage prefix opcode annotation
 -> GenericInstruction label storage prefix opcode annotation
 -> Bool)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> Bool)
-> Eq (GenericInstruction label storage prefix opcode annotation)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall label storage prefix opcode annotation.
(Eq label, Eq prefix, Eq opcode, Eq storage, Eq annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
/= :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
$c/= :: forall label storage prefix opcode annotation.
(Eq label, Eq prefix, Eq opcode, Eq storage, Eq annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
== :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
$c== :: forall label storage prefix opcode annotation.
(Eq label, Eq prefix, Eq opcode, Eq storage, Eq annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
Eq, Eq (GenericInstruction label storage prefix opcode annotation)
Eq (GenericInstruction label storage prefix opcode annotation)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> Ordering)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> Bool)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> Bool)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> Bool)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> Bool)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation)
-> (GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation
    -> GenericInstruction label storage prefix opcode annotation)
-> Ord (GenericInstruction label storage prefix opcode annotation)
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Ordering
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
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
forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
Eq (GenericInstruction label storage prefix opcode annotation)
forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Ordering
forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
min :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
$cmin :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
max :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
$cmax :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
>= :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
$c>= :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
> :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
$c> :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
<= :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
$c<= :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
< :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
$c< :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Bool
compare :: GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Ordering
$ccompare :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
GenericInstruction label storage prefix opcode annotation
-> GenericInstruction label storage prefix opcode annotation
-> Ordering
$cp1Ord :: forall label storage prefix opcode annotation.
(Ord label, Ord prefix, Ord opcode, Ord storage, Ord annotation) =>
Eq (GenericInstruction label storage prefix opcode annotation)
Ord, (forall x.
 GenericInstruction label storage prefix opcode annotation
 -> Rep
      (GenericInstruction label storage prefix opcode annotation) x)
-> (forall x.
    Rep (GenericInstruction label storage prefix opcode annotation) x
    -> GenericInstruction label storage prefix opcode annotation)
-> Generic
     (GenericInstruction label storage prefix opcode annotation)
forall x.
Rep (GenericInstruction label storage prefix opcode annotation) x
-> GenericInstruction label storage prefix opcode annotation
forall x.
GenericInstruction label storage prefix opcode annotation
-> Rep
     (GenericInstruction label storage prefix opcode annotation) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall label storage prefix opcode annotation x.
Rep (GenericInstruction label storage prefix opcode annotation) x
-> GenericInstruction label storage prefix opcode annotation
forall label storage prefix opcode annotation x.
GenericInstruction label storage prefix opcode annotation
-> Rep
     (GenericInstruction label storage prefix opcode annotation) x
$cto :: forall label storage prefix opcode annotation x.
Rep (GenericInstruction label storage prefix opcode annotation) x
-> GenericInstruction label storage prefix opcode annotation
$cfrom :: forall label storage prefix opcode annotation x.
GenericInstruction label storage prefix opcode annotation
-> Rep
     (GenericInstruction label storage prefix opcode annotation) x
Generic)

instance ( Cereal.Serialize label
         , Cereal.Serialize storage
         , Cereal.Serialize prefix
         , Cereal.Serialize opcode
         , Cereal.Serialize annotation)
  => Cereal.Serialize (GenericInstruction
                         label
                         storage
                         prefix
                         opcode
                         annotation)

instance ( NFData label
         , NFData storage
         , NFData prefix
         , NFData opcode
         , NFData annotation)
  => NFData (GenericInstruction
               label
               storage
               prefix
               opcode
               annotation)

instance (Show storage, Show label, Show prefix, Show opcode, Show annotation)
  => Show (GenericInstruction label storage prefix opcode annotation) where
  show :: GenericInstruction label storage prefix opcode annotation -> String
show (Instruction label
label Maybe prefix
prefix opcode
opcode Maybe (GenericOperand storage)
dst [GenericOperand storage]
srcs Maybe annotation
annot) = label -> String
forall a. Show a => a -> String
show label
label
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe prefix -> String
forall a. Show a => Maybe a -> String
showPrefix Maybe prefix
prefix
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ opcode -> String
forall a. Show a => a -> String
show opcode
opcode
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (GenericOperand storage) -> String
forall a. Show a => Maybe a -> String
showDest Maybe (GenericOperand storage)
dst
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((GenericOperand storage -> String)
-> [GenericOperand storage] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GenericOperand storage -> String
forall a. Show a => a -> String
show [GenericOperand storage]
srcs)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe annotation -> String
forall a. Show a => Maybe a -> String
showAnnot Maybe annotation
annot
    where
      showPrefix :: Maybe a -> String
showPrefix Maybe a
Nothing = String
""
      showPrefix (Just a
pre) = a -> String
forall a. Show a => a -> String
show a
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "

      showAnnot :: Maybe a -> String
showAnnot Maybe a
Nothing = String
""
      showAnnot (Just a
annot) = String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
annot String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

      showDest :: Maybe a -> String
showDest Maybe a
Nothing = String
""
      showDest (Just a
op) = a -> String
forall a. Show a => a -> String
show a
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <- "