{- Generated by DrIFT (Automatic class derivations for Haskell) -}
{-# LINE 1 "src/Cmm/Op.hs" #-}
{-# OPTIONS -funbox-strict-fields #-}
module Cmm.Op where

import Data.Binary
import Util.Gen
import Text.ParserCombinators.ReadP as P
import Text.Read.Lex

{-

Basic operations. These are chosen to be roughly equivalent to c-- operations,
but can be effectively used to generate C or assembly code as well.

An operation consists of the operation itself, the type of the arguments and
return value, and a hint attached to each argument.

A condition is that the operation must be fully determined by the operation
name and the type of its arguments. this specifically does not include the
hint. For instance, since whether a number is signed or unsigned is in the
hint, so the operation itself must say whether it is signed or unsigned.

Also, distinct algorithms should be given different operations, for instance
floating point and integer comparison are so different that they should be
separate opcodes, even if it could be determined by the type they operate on.

-}

-- these take 2 arguments of the same type, and return one of the same type.
-- an exception are the mulx routines, which may return a type exactly
-- double in size of the original, and the shift and rotate routines, where the
-- second argument may be of any width and is interpreted as an unsigned
-- number.
--
-- the invarient is that the return type is always exactly determined by the
-- argument types

data BinOp
    = Add
    | Sub

    | Mul
    | Mulx
    | UMulx

    | Div   -- ^ round to -Infinity
    | Mod   -- ^ mod rounding to -Infinity

    | Quot  -- ^ round to 0
    | Rem   -- ^ rem rounding to 0

    | UDiv  -- ^ round to zero (unsigned)
    | UMod  -- ^ unsigned mod

    -- bitwise
    | And
    | Or
    | Xor
    | Shl
    | Shr    -- ^ shift right logical
    | Shra   -- ^ shift right arithmetic
    | Rotl
    | Rotr

    -- floating
    | FAdd
    | FSub
    | FDiv
    | FMul
    | FPwr
    | FAtan2

    -- These all compare two things of the same type, and return a boolean.
    | Eq
    | NEq
    | Gt
    | Gte
    | Lt
    | Lte
    -- unsigned versions
    | UGt
    | UGte
    | ULt
    | ULte

    -- floating point comparasons
    | FEq
    | FNEq
    | FGt
    | FGte
    | FLt
    | FLte
    -- whether two values can be compared at all.
    | FOrdered
    deriving(Eq,Show,Ord,Read,Enum,Bounded)
    {-! derive: Binary !-}

data UnOp
    = Neg   -- ^ 2s compliment negation
    | Com   -- ^ bitwise compliment
    -- floating
    | FAbs  -- ^ floating absolute value
    | FNeg  -- ^ floating point negation
    | Sin
    | Cos
    | Tan
    | Sinh
    | Cosh
    | Tanh
    | Asin
    | Acos
    | Atan
    | Log
    | Exp
    | Sqrt
    -- exotic bit operations
    | Bswap  -- ^ Switch the order of the bytes in a word
    | Ffs    -- ^ Returns one plus the index of the least
             --   significant 1-bit of x, 0 if x is zero.
    | Clz    -- ^ number of leading (from MSB) zeros, undefined if zero
    | Ctz    -- ^ number of trailing (from LSB) zeros, undefined if zero.
    | Popcount -- ^ number of bits set to 1 in word
    | Parity   -- ^ number of bits set to 1 mod 2
    deriving(Eq,Show,Ord,Read,Enum,Bounded)
    {-! derive: Binary !-}

-- conversion ops

data ConvOp
    = F2I         -- ^ convert a floating point to an integral value via truncation
    | F2U         -- ^ convert a floating point to an unsigned integral value via truncation, negative values become zero
    | U2F         -- ^ convert an unsigned integral value to a floating point number
    | I2F         -- ^ convert an integral value to a floating point number
    | F2F         -- ^ convert a float from one precision to another, preserving value as much as possible
    | Lobits      -- ^ extract the low order bits
    | Sx          -- ^ sign extend a value (signed)
    | Zx          -- ^ zero extend a value (unsigned)
    | I2I         -- ^ perform a 'Lobits' or a 'Sx' depending on the sizes of the arguments
    | U2U         -- ^ perform a 'Lobits' or a 'Zx' depending on the sizes of the arguments
    | B2B         -- ^ a nop, useful for coercing hints (bits 2 bits)
    deriving(Eq,Show,Ord,Read,Enum,Bounded)
    {-! derive: Binary !-}

data ValOp
    = NaN
    | PInf
    | NInf
    | PZero
    | NZero
    deriving(Eq,Show,Ord,Read,Bounded)
    {-! derive: Binary !-}

data ArchBits = BitsMax | BitsPtr | BitsUnknown
    deriving(Eq,Ord)
    {-! derive: Binary !-}

data TyBits = Bits {-# UNPACK #-} !Int | BitsArch !ArchBits |  BitsExt String
    deriving(Eq,Ord)
    {-! derive: Binary !-}

data TyHint
    = HintSigned
    | HintUnsigned
    | HintFloat        -- an IEEE floating point value
    | HintCharacter    -- a unicode character, implies unsigned
    | HintNone         -- no hint
    deriving(Eq,Ord)
    {-! derive: Binary !-}

data Ty
    = TyBits !TyBits !TyHint
    | TyBool
    | TyComplex Ty
    | TyVector !Int Ty
    deriving(Eq,Ord)
    {-! derive: Binary !-}

--runReadP :: ReadP a -> String -> Maybe a
--runReadP rp s = case readP_to_S rp s of
--    [(x,"")] -> Just x
--    _ -> Nothing

preadTy :: ReadP Ty
preadTy = choice cs where
    cs = [ do string "bool"; return TyBool
         , do char 's'; TyBits x _ <- preadTy; return $ TyBits x HintSigned
         , do char 'u'; TyBits x _ <- preadTy; return $ TyBits x HintUnsigned
         , do char 'f'; TyBits x _ <- preadTy; return $ TyBits x HintFloat
         , do char 'c'; TyBits x _ <- preadTy; return $ TyBits x HintCharacter
         , do string "bits<"; x <- manyTill P.get (char '>'); return $ TyBits (f x) HintNone
         , do string "bits"; x <- readDecP; return $ TyBits (Bits x) HintNone
         , do n <- readDecP; char '*'; t <- preadTy; return (TyVector n t)
         , do string "i"; t <- preadTy; return (TyComplex t)
         ]
    f "ptr" = BitsArch BitsPtr
    f "max" = BitsArch BitsMax
    f "?"   = BitsArch BitsUnknown
    f x     = BitsExt x

readTy :: Monad m => String -> m Ty
readTy s = case runReadP preadTy s of
    Nothing -> fail "readTy: not type"
    Just x -> return x

stringToOpTy ::  String -> Ty
stringToOpTy s = case readTy s of
    Just t -> t
    _ -> error $ "stringToOpTy: " ++ show s

bool = TyBool
bits_ptr = TyBits (BitsArch BitsPtr) HintNone
bits_max = TyBits (BitsArch BitsMax) HintNone
bits8    = TyBits (Bits 8)  HintNone
bits16   = TyBits (Bits 16) HintNone
bits32   = TyBits (Bits 32) HintNone
bits64   = TyBits (Bits 64) HintNone

class ToCmmTy a where
    toCmmTy :: a -> Maybe Ty

instance ToCmmTy Ty where
    toCmmTy a = Just a

instance ToCmmTy String where
    toCmmTy s = readTy s

cmmTyBits :: ToCmmTy a => a -> Maybe Int
cmmTyBits x = do TyBits (Bits b) _ <- toCmmTy x; return b
cmmTyHint x = do TyBits _ hint <- toCmmTy x; return hint

instance Show TyHint where
    showsPrec _ HintSigned = ('s':)
    showsPrec _ HintUnsigned = ('u':)
    showsPrec _ HintFloat = ('f':)
    showsPrec _ HintCharacter = ('c':)
    showsPrec _ HintNone = id

instance Show Ty where
    showsPrec _ TyBool = showString "bool"
    showsPrec _ (TyBits b h) = shows h . showString "bits" . shows b
    showsPrec _ (TyVector n t) = shows n . showChar '*' . shows t
    showsPrec _ (TyComplex t) = showChar 'i' . shows t

instance Show TyBits where
    showsPrec _ (Bits n) = shows n
    showsPrec _ (BitsExt s) = showChar '<' . showString s . showChar '>'
    showsPrec _ (BitsArch s) = showChar '<' . shows s . showChar '>'

instance Show ArchBits where
    show BitsMax = "max"
    show BitsPtr = "ptr"
    show BitsUnknown = "?"

data Op v
    = BinOp BinOp v v
    | UnOp UnOp v
    | ValOp ValOp
    | ConvOp ConvOp v
    deriving(Eq,Show,Ord)
    {-! derive: Binary !-}

binopType :: BinOp -> Ty -> Ty -> Ty
binopType Mulx  (TyBits (Bits i) h) _ = TyBits (Bits (i*2)) h
binopType UMulx (TyBits (Bits i) h) _ = TyBits (Bits (i*2)) h
binopType Eq  _ _ =  TyBool
binopType NEq _ _ =  TyBool
binopType Gt  _ _ =  TyBool
binopType Gte _ _ =  TyBool
binopType Lt  _ _ =  TyBool
binopType Lte _ _ =  TyBool
binopType UGt  _ _ =  TyBool
binopType UGte _ _ =  TyBool
binopType ULt  _ _ =  TyBool
binopType ULte _ _ =  TyBool
binopType FEq  _ _ =  TyBool
binopType FNEq _ _ =  TyBool
binopType FGt  _ _ =  TyBool
binopType FGte _ _ =  TyBool
binopType FLt  _ _ =  TyBool
binopType FLte _ _ =  TyBool
binopType FOrdered _ _ =  TyBool
binopType _ t1 _ = t1

isCommutable :: BinOp -> Bool
isCommutable x = f x where
    f Add = True
    f Mul = True
    f And = True
    f Or  = True
    f Xor = True
    f Eq  = True
    f NEq = True
    f FAdd = True
    f FMul = True
    f FEq  = True
    f FNEq = True
    f FOrdered = True
    f _ = False

commuteBinOp :: BinOp -> Maybe BinOp
commuteBinOp x | isCommutable x = return x
commuteBinOp Lt = return Gt
commuteBinOp Gt = return Lt
commuteBinOp Lte = return Gte
commuteBinOp Gte = return Lte
commuteBinOp ULt = return UGt
commuteBinOp UGt = return ULt
commuteBinOp ULte = return UGte
commuteBinOp UGte = return ULte
commuteBinOp FLt = return FGt
commuteBinOp FGt = return FLt
commuteBinOp FLte = return FGte
commuteBinOp FGte = return FLte
commuteBinOp _ = Nothing

isAssociative :: BinOp -> Bool
isAssociative x = f x where
    f Add = True
    f Mul = True
    f And = True
    f Or  = True
    f Xor = True
    f _ = False

unopFloat :: Ty -> UnOp -> Maybe String
unopFloat (TyBits b HintFloat) op = g b =<< f op where
    g (Bits 64) x = return x
    g (Bits 32) x = return $ x ++ "f"
    g _ _ = Nothing
    f FAbs = return "fabs"
    f Sin  = return "sin"
    f Cos  = return "cos"
    f Tan  = return "tan"
    f Sinh  = return "sinh"
    f Cosh  = return "cosh"
    f Tanh  = return "tanh"
    f Asin  = return "asin"
    f Acos  = return "acos"
    f Atan  = return "atan"
    f Sqrt = return "sqrt"
    f Log = return "log"
    f Exp = return "exp"

    f _ = Nothing
unopFloat _ _ = Nothing

binopFunc :: Ty -> Ty -> BinOp -> Maybe String
binopFunc (TyBits b _) _ bop = g b =<< f bop where
    g (Bits 64) x = return x
    g (Bits 32) x = return $ x ++ "f"
    g _ _ = Nothing
    f FPwr = Just "pow"
    f FAtan2 = Just "atan2"
    f _ = Nothing
binopFunc TyBool _ bop = Nothing
binopFunc _ _ _ = error "Op.binopFunc: bad."

binopInfix :: BinOp -> Maybe (String,Int)
binopInfix UDiv = Just ("/",8)
binopInfix Mul  = Just ("*",8)
binopInfix UMod = Just ("%",8)
binopInfix Sub  = Just ("-",7)
binopInfix Add  = Just ("+",7)
binopInfix Shr  = Just (">>",6)
binopInfix Shl  = Just ("<<",6)
binopInfix And  = Just ("&",5)
binopInfix Xor  = Just ("^",4)
binopInfix Or   = Just ("|",3)
binopInfix UGte = Just (">=",2)
binopInfix UGt  = Just (">",2)
binopInfix ULte = Just ("<=",2)
binopInfix ULt  = Just ("<",2)
binopInfix Eq   = Just ("==",2)
binopInfix NEq  = Just ("!=",2)
binopInfix _ = Nothing

class IsOperator o where
    isCheap :: o -> Bool
    isEagerSafe :: o -> Bool

instance IsOperator BinOp where
    isCheap FAtan2 = False
    isCheap _ = True

    isEagerSafe Div = False
    isEagerSafe Mod = False
    isEagerSafe Quot = False
    isEagerSafe Rem  = False
    isEagerSafe UDiv = False
    isEagerSafe UMod = False
    isEagerSafe _ = True

instance IsOperator UnOp where
    isCheap _ = True
    isEagerSafe _ = True

instance IsOperator ConvOp where
    isCheap _ = True
    isEagerSafe _ = True

instance IsOperator (Op v) where
    isCheap (BinOp o _ _) = isCheap o
    isCheap (UnOp o _) = isCheap o
    isCheap (ConvOp o _) = isCheap o
    isCheap _ = False
    isEagerSafe (BinOp o _ _) = isEagerSafe o
    isEagerSafe (UnOp o _) = isEagerSafe o
    isEagerSafe (ConvOp o _) = isEagerSafe o
    isEagerSafe _ = False
{-* Generated by DrIFT : Look, but Don't Touch. *-}
instance Data.Binary.Binary BinOp where
    put Add = do
	    Data.Binary.putWord8 0
    put Sub = do
	    Data.Binary.putWord8 1
    put Mul = do
	    Data.Binary.putWord8 2
    put Mulx = do
	    Data.Binary.putWord8 3
    put UMulx = do
	    Data.Binary.putWord8 4
    put Div = do
	    Data.Binary.putWord8 5
    put Mod = do
	    Data.Binary.putWord8 6
    put Quot = do
	    Data.Binary.putWord8 7
    put Rem = do
	    Data.Binary.putWord8 8
    put UDiv = do
	    Data.Binary.putWord8 9
    put UMod = do
	    Data.Binary.putWord8 10
    put And = do
	    Data.Binary.putWord8 11
    put Or = do
	    Data.Binary.putWord8 12
    put Xor = do
	    Data.Binary.putWord8 13
    put Shl = do
	    Data.Binary.putWord8 14
    put Shr = do
	    Data.Binary.putWord8 15
    put Shra = do
	    Data.Binary.putWord8 16
    put Rotl = do
	    Data.Binary.putWord8 17
    put Rotr = do
	    Data.Binary.putWord8 18
    put FAdd = do
	    Data.Binary.putWord8 19
    put FSub = do
	    Data.Binary.putWord8 20
    put FDiv = do
	    Data.Binary.putWord8 21
    put FMul = do
	    Data.Binary.putWord8 22
    put FPwr = do
	    Data.Binary.putWord8 23
    put FAtan2 = do
	    Data.Binary.putWord8 24
    put Eq = do
	    Data.Binary.putWord8 25
    put NEq = do
	    Data.Binary.putWord8 26
    put Gt = do
	    Data.Binary.putWord8 27
    put Gte = do
	    Data.Binary.putWord8 28
    put Lt = do
	    Data.Binary.putWord8 29
    put Lte = do
	    Data.Binary.putWord8 30
    put UGt = do
	    Data.Binary.putWord8 31
    put UGte = do
	    Data.Binary.putWord8 32
    put ULt = do
	    Data.Binary.putWord8 33
    put ULte = do
	    Data.Binary.putWord8 34
    put FEq = do
	    Data.Binary.putWord8 35
    put FNEq = do
	    Data.Binary.putWord8 36
    put FGt = do
	    Data.Binary.putWord8 37
    put FGte = do
	    Data.Binary.putWord8 38
    put FLt = do
	    Data.Binary.putWord8 39
    put FLte = do
	    Data.Binary.putWord8 40
    put FOrdered = do
	    Data.Binary.putWord8 41
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    return Add
	      1 -> do
		    return Sub
	      2 -> do
		    return Mul
	      3 -> do
		    return Mulx
	      4 -> do
		    return UMulx
	      5 -> do
		    return Div
	      6 -> do
		    return Mod
	      7 -> do
		    return Quot
	      8 -> do
		    return Rem
	      9 -> do
		    return UDiv
	      10 -> do
		    return UMod
	      11 -> do
		    return And
	      12 -> do
		    return Or
	      13 -> do
		    return Xor
	      14 -> do
		    return Shl
	      15 -> do
		    return Shr
	      16 -> do
		    return Shra
	      17 -> do
		    return Rotl
	      18 -> do
		    return Rotr
	      19 -> do
		    return FAdd
	      20 -> do
		    return FSub
	      21 -> do
		    return FDiv
	      22 -> do
		    return FMul
	      23 -> do
		    return FPwr
	      24 -> do
		    return FAtan2
	      25 -> do
		    return Eq
	      26 -> do
		    return NEq
	      27 -> do
		    return Gt
	      28 -> do
		    return Gte
	      29 -> do
		    return Lt
	      30 -> do
		    return Lte
	      31 -> do
		    return UGt
	      32 -> do
		    return UGte
	      33 -> do
		    return ULt
	      34 -> do
		    return ULte
	      35 -> do
		    return FEq
	      36 -> do
		    return FNEq
	      37 -> do
		    return FGt
	      38 -> do
		    return FGte
	      39 -> do
		    return FLt
	      40 -> do
		    return FLte
	      41 -> do
		    return FOrdered
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary UnOp where
    put Neg = do
	    Data.Binary.putWord8 0
    put Com = do
	    Data.Binary.putWord8 1
    put FAbs = do
	    Data.Binary.putWord8 2
    put FNeg = do
	    Data.Binary.putWord8 3
    put Sin = do
	    Data.Binary.putWord8 4
    put Cos = do
	    Data.Binary.putWord8 5
    put Tan = do
	    Data.Binary.putWord8 6
    put Sinh = do
	    Data.Binary.putWord8 7
    put Cosh = do
	    Data.Binary.putWord8 8
    put Tanh = do
	    Data.Binary.putWord8 9
    put Asin = do
	    Data.Binary.putWord8 10
    put Acos = do
	    Data.Binary.putWord8 11
    put Atan = do
	    Data.Binary.putWord8 12
    put Log = do
	    Data.Binary.putWord8 13
    put Exp = do
	    Data.Binary.putWord8 14
    put Sqrt = do
	    Data.Binary.putWord8 15
    put Bswap = do
	    Data.Binary.putWord8 16
    put Ffs = do
	    Data.Binary.putWord8 17
    put Clz = do
	    Data.Binary.putWord8 18
    put Ctz = do
	    Data.Binary.putWord8 19
    put Popcount = do
	    Data.Binary.putWord8 20
    put Parity = do
	    Data.Binary.putWord8 21
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    return Neg
	      1 -> do
		    return Com
	      2 -> do
		    return FAbs
	      3 -> do
		    return FNeg
	      4 -> do
		    return Sin
	      5 -> do
		    return Cos
	      6 -> do
		    return Tan
	      7 -> do
		    return Sinh
	      8 -> do
		    return Cosh
	      9 -> do
		    return Tanh
	      10 -> do
		    return Asin
	      11 -> do
		    return Acos
	      12 -> do
		    return Atan
	      13 -> do
		    return Log
	      14 -> do
		    return Exp
	      15 -> do
		    return Sqrt
	      16 -> do
		    return Bswap
	      17 -> do
		    return Ffs
	      18 -> do
		    return Clz
	      19 -> do
		    return Ctz
	      20 -> do
		    return Popcount
	      21 -> do
		    return Parity
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary ConvOp where
    put F2I = do
	    Data.Binary.putWord8 0
    put F2U = do
	    Data.Binary.putWord8 1
    put U2F = do
	    Data.Binary.putWord8 2
    put I2F = do
	    Data.Binary.putWord8 3
    put F2F = do
	    Data.Binary.putWord8 4
    put Lobits = do
	    Data.Binary.putWord8 5
    put Sx = do
	    Data.Binary.putWord8 6
    put Zx = do
	    Data.Binary.putWord8 7
    put I2I = do
	    Data.Binary.putWord8 8
    put U2U = do
	    Data.Binary.putWord8 9
    put B2B = do
	    Data.Binary.putWord8 10
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    return F2I
	      1 -> do
		    return F2U
	      2 -> do
		    return U2F
	      3 -> do
		    return I2F
	      4 -> do
		    return F2F
	      5 -> do
		    return Lobits
	      6 -> do
		    return Sx
	      7 -> do
		    return Zx
	      8 -> do
		    return I2I
	      9 -> do
		    return U2U
	      10 -> do
		    return B2B
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary ValOp where
    put NaN = do
	    Data.Binary.putWord8 0
    put PInf = do
	    Data.Binary.putWord8 1
    put NInf = do
	    Data.Binary.putWord8 2
    put PZero = do
	    Data.Binary.putWord8 3
    put NZero = do
	    Data.Binary.putWord8 4
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    return NaN
	      1 -> do
		    return PInf
	      2 -> do
		    return NInf
	      3 -> do
		    return PZero
	      4 -> do
		    return NZero
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary ArchBits where
    put BitsMax = do
	    Data.Binary.putWord8 0
    put BitsPtr = do
	    Data.Binary.putWord8 1
    put BitsUnknown = do
	    Data.Binary.putWord8 2
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    return BitsMax
	      1 -> do
		    return BitsPtr
	      2 -> do
		    return BitsUnknown
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary TyBits where
    put (Bits aa) = do
	    Data.Binary.putWord8 0
	    Data.Binary.put aa
    put (BitsArch ab) = do
	    Data.Binary.putWord8 1
	    Data.Binary.put ab
    put (BitsExt ac) = do
	    Data.Binary.putWord8 2
	    Data.Binary.put ac
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    aa <- Data.Binary.get
		    return (Bits aa)
	      1 -> do
		    ab <- Data.Binary.get
		    return (BitsArch ab)
	      2 -> do
		    ac <- Data.Binary.get
		    return (BitsExt ac)
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary TyHint where
    put HintSigned = do
	    Data.Binary.putWord8 0
    put HintUnsigned = do
	    Data.Binary.putWord8 1
    put HintFloat = do
	    Data.Binary.putWord8 2
    put HintCharacter = do
	    Data.Binary.putWord8 3
    put HintNone = do
	    Data.Binary.putWord8 4
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    return HintSigned
	      1 -> do
		    return HintUnsigned
	      2 -> do
		    return HintFloat
	      3 -> do
		    return HintCharacter
	      4 -> do
		    return HintNone
	      _ -> fail "invalid binary data found"

instance Data.Binary.Binary Ty where
    put (TyBits aa ab) = do
	    Data.Binary.putWord8 0
	    Data.Binary.put aa
	    Data.Binary.put ab
    put TyBool = do
	    Data.Binary.putWord8 1
    put (TyComplex ac) = do
	    Data.Binary.putWord8 2
	    Data.Binary.put ac
    put (TyVector ad ae) = do
	    Data.Binary.putWord8 3
	    Data.Binary.put ad
	    Data.Binary.put ae
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    aa <- Data.Binary.get
		    ab <- Data.Binary.get
		    return (TyBits aa ab)
	      1 -> do
		    return TyBool
	      2 -> do
		    ac <- Data.Binary.get
		    return (TyComplex ac)
	      3 -> do
		    ad <- Data.Binary.get
		    ae <- Data.Binary.get
		    return (TyVector ad ae)
	      _ -> fail "invalid binary data found"

instance (Data.Binary.Binary v) => Data.Binary.Binary (Op v) where
    put (BinOp aa ab ac) = do
	    Data.Binary.putWord8 0
	    Data.Binary.put aa
	    Data.Binary.put ab
	    Data.Binary.put ac
    put (UnOp ad ae) = do
	    Data.Binary.putWord8 1
	    Data.Binary.put ad
	    Data.Binary.put ae
    put (ValOp af) = do
	    Data.Binary.putWord8 2
	    Data.Binary.put af
    put (ConvOp ag ah) = do
	    Data.Binary.putWord8 3
	    Data.Binary.put ag
	    Data.Binary.put ah
    get = do
	    h <- Data.Binary.getWord8
	    case h of
	      0 -> do
		    aa <- Data.Binary.get
		    ab <- Data.Binary.get
		    ac <- Data.Binary.get
		    return (BinOp aa ab ac)
	      1 -> do
		    ad <- Data.Binary.get
		    ae <- Data.Binary.get
		    return (UnOp ad ae)
	      2 -> do
		    af <- Data.Binary.get
		    return (ValOp af)
	      3 -> do
		    ag <- Data.Binary.get
		    ah <- Data.Binary.get
		    return (ConvOp ag ah)
	      _ -> fail "invalid binary data found"

--  Imported from other files :-