{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Array.Knead.Shape.Orphan where

import qualified Data.Array.Knead.Expression as Expr

import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Shape
         (ZeroBased(ZeroBased), Range(Range), Shifted(Shifted),
          Enumeration(Enumeration))

import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple

import qualified Control.Monad.HT as Monad
import Control.Applicative ((<$>))

import Prelude2010
import Prelude ()



unzipZeroBased :: MultiValue.T (ZeroBased n) -> ZeroBased (MultiValue.T n)
unzipZeroBased (MultiValue.Cons (ZeroBased n)) = ZeroBased (MultiValue.Cons n)

zeroBasedSize :: (Expr.Value val) => val (ZeroBased n) -> val n
zeroBasedSize = Expr.lift1 $ Shape.zeroBasedSize . unzipZeroBased

zeroBased :: (Expr.Value val) => val n -> val (ZeroBased n)
zeroBased = Expr.lift1 $ \(MultiValue.Cons n) -> MultiValue.Cons (ZeroBased n)

instance (Tuple.Undefined n) => Tuple.Undefined (ZeroBased n) where
   undef = ZeroBased Tuple.undef

instance (Tuple.Phi n) => Tuple.Phi (ZeroBased n) where
   phi bb = fmap ZeroBased . Tuple.phi bb . Shape.zeroBasedSize
   addPhi bb (Shape.ZeroBased a) (Shape.ZeroBased b) = Tuple.addPhi bb a b

instance (Tuple.Value n) => Tuple.Value (ZeroBased n) where
   type ValueOf (ZeroBased n) = ZeroBased (Tuple.ValueOf n)
   valueOf (ZeroBased n) = ZeroBased $ Tuple.valueOf n

instance (MultiValue.C n) => MultiValue.C (ZeroBased n) where
   cons (ZeroBased n) = zeroBased (MultiValue.cons n)
   undef = zeroBased MultiValue.undef
   zero = zeroBased MultiValue.zero
   phi bb = Monad.lift zeroBased . MultiValue.phi bb . zeroBasedSize
   addPhi bb a b = MultiValue.addPhi bb (zeroBasedSize a) (zeroBasedSize b)

type instance
   MultiValue.Decomposed f (ZeroBased pn) =
      ZeroBased (MultiValue.Decomposed f pn)
type instance
   MultiValue.PatternTuple (ZeroBased pn) =
      ZeroBased (MultiValue.PatternTuple pn)

instance (MultiValue.Compose n) => MultiValue.Compose (ZeroBased n) where
   type Composed (ZeroBased n) = ZeroBased (MultiValue.Composed n)
   compose (ZeroBased n) = zeroBased (MultiValue.compose n)

instance (MultiValue.Decompose pn) => MultiValue.Decompose (ZeroBased pn) where
   decompose (ZeroBased p) sh =
      MultiValue.decompose p <$> unzipZeroBased sh

instance (Expr.Compose n) => Expr.Compose (ZeroBased n) where
   type Composed (ZeroBased n) = ZeroBased (Expr.Composed n)
   compose (ZeroBased n) = Expr.lift1 zeroBased (Expr.compose n)

instance (Expr.Decompose pn) => Expr.Decompose (ZeroBased pn) where
   decompose (ZeroBased p) = ZeroBased . Expr.decompose p . zeroBasedSize

instance (Memory.C n) => Memory.C (ZeroBased n) where
   type Struct (ZeroBased n) = Memory.Struct n
   compose = Memory.compose . Shape.zeroBasedSize
   decompose = fmap ZeroBased . Memory.decompose

instance (Marshal.C n) => Marshal.C (ZeroBased n) where
   pack = Marshal.pack . Shape.zeroBasedSize
   unpack = Shape.ZeroBased . Marshal.unpack

instance (Marshal.MV n) => Marshal.MV (ZeroBased n) where



singletonRange :: n -> Range n
singletonRange n = Range n n

unzipRange :: MultiValue.T (Range n) -> Range (MultiValue.T n)
unzipRange (MultiValue.Cons (Range from to)) =
   Range (MultiValue.Cons from) (MultiValue.Cons to)

zipRange :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Range n)
zipRange (MultiValue.Cons from) (MultiValue.Cons to) =
   MultiValue.Cons (Range from to)

instance (Tuple.Undefined n) => Tuple.Undefined (Range n) where
   undef = Range Tuple.undef Tuple.undef

instance (Tuple.Value n) => Tuple.Value (Range n) where
   type ValueOf (Range n) = Range (Tuple.ValueOf n)
   valueOf (Range from to) = Range (Tuple.valueOf from) (Tuple.valueOf to)

instance (MultiValue.C n) => MultiValue.C (Range n) where
   cons (Range from to) = zipRange (MultiValue.cons from) (MultiValue.cons to)
   undef = MultiValue.compose $ singletonRange MultiValue.undef
   zero = MultiValue.compose $ singletonRange MultiValue.zero
   phi bb a =
      case unzipRange a of
         Range a0 a1 ->
            Monad.lift2 zipRange (MultiValue.phi bb a0) (MultiValue.phi bb a1)
   addPhi bb a b =
      case (unzipRange a, unzipRange b) of
         (Range a0 a1, Range b0 b1) ->
            MultiValue.addPhi bb a0 b0 >>
            MultiValue.addPhi bb a1 b1

type instance
   MultiValue.Decomposed f (Range pn) = Range (MultiValue.Decomposed f pn)
type instance
   MultiValue.PatternTuple (Range pn) = Range (MultiValue.PatternTuple pn)

instance (MultiValue.Compose n) => MultiValue.Compose (Range n) where
   type Composed (Range n) = Range (MultiValue.Composed n)
   compose (Range from to) =
      zipRange (MultiValue.compose from) (MultiValue.compose to)

instance (MultiValue.Decompose pn) => MultiValue.Decompose (Range pn) where
   decompose (Range pfrom pto) rng =
      case unzipRange rng of
         Range from to ->
            Range
               (MultiValue.decompose pfrom from)
               (MultiValue.decompose pto to)



singletonShifted :: n -> Shifted n
singletonShifted n = Shifted n n

unzipShifted :: MultiValue.T (Shifted n) -> Shifted (MultiValue.T n)
unzipShifted (MultiValue.Cons (Shifted from to)) =
   Shifted (MultiValue.Cons from) (MultiValue.Cons to)

zipShifted :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Shifted n)
zipShifted (MultiValue.Cons from) (MultiValue.Cons to) =
   MultiValue.Cons (Shifted from to)

instance (Tuple.Undefined n) => Tuple.Undefined (Shifted n) where
   undef = Shifted Tuple.undef Tuple.undef

instance (Tuple.Value n) => Tuple.Value (Shifted n) where
   type ValueOf (Shifted n) = Shifted (Tuple.ValueOf n)
   valueOf (Shifted start len) =
      Shifted (Tuple.valueOf start) (Tuple.valueOf len)

instance (MultiValue.C n) => MultiValue.C (Shifted n) where
   cons (Shifted start len) =
      zipShifted (MultiValue.cons start) (MultiValue.cons len)
   undef = MultiValue.compose $ singletonShifted MultiValue.undef
   zero = MultiValue.compose $ singletonShifted MultiValue.zero
   phi bb a =
      case unzipShifted a of
         Shifted a0 a1 ->
            Monad.lift2 zipShifted
               (MultiValue.phi bb a0) (MultiValue.phi bb a1)
   addPhi bb a b =
      case (unzipShifted a, unzipShifted b) of
         (Shifted a0 a1, Shifted b0 b1) ->
            MultiValue.addPhi bb a0 b0 >>
            MultiValue.addPhi bb a1 b1

type instance
   MultiValue.Decomposed f (Shifted pn) =
      Shifted (MultiValue.Decomposed f pn)
type instance
   MultiValue.PatternTuple (Shifted pn) =
      Shifted (MultiValue.PatternTuple pn)

instance (MultiValue.Compose n) => MultiValue.Compose (Shifted n) where
   type Composed (Shifted n) = Shifted (MultiValue.Composed n)
   compose (Shifted start len) =
      zipShifted (MultiValue.compose start) (MultiValue.compose len)

instance (MultiValue.Decompose pn) => MultiValue.Decompose (Shifted pn) where
   decompose (Shifted pstart plen) rng =
      case unzipShifted rng of
         Shifted start len ->
            Shifted
               (MultiValue.decompose pstart start)
               (MultiValue.decompose plen len)



instance (Enum enum, Bounded enum) => Tuple.Value (Enumeration enum) where
   type ValueOf (Enumeration enum) = ()
   valueOf Enumeration = ()

instance (Enum enum, Bounded enum) => MultiValue.C (Enumeration enum) where
   cons = MultiValue.consUnit
   undef = MultiValue.undefUnit
   zero = MultiValue.zeroUnit
   phi = MultiValue.phiUnit
   addPhi = MultiValue.addPhiUnit

type instance MultiValue.Decomposed f (Enumeration enum) = Enumeration enum
type instance MultiValue.PatternTuple (Enumeration enum) = Enumeration enum

instance
      (Enum enum, Bounded enum) => MultiValue.Compose (Enumeration enum) where
   type Composed (Enumeration enum) = Enumeration enum
   compose = MultiValue.cons

instance MultiValue.Decompose (Enumeration enum) where
   decompose Enumeration _ = Enumeration


instance (Enum enum, Bounded enum) => Expr.Compose (Enumeration enum) where
   type Composed (Enumeration enum) = Enumeration enum
   compose = Expr.cons

instance Expr.Decompose (Enumeration enum) where
   decompose Enumeration _ = Enumeration