{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Atom.Skel.Vector.Core
-- Copyright   :  (c) George Ungureanu, KTH/ICT/ESY 2016
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  ugeorge@kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- The core implementation of the 'Vector' type
-----------------------------------------------------------------------------
module ForSyDe.Atom.Skel.Vector.Core where

import ForSyDe.Atom.Skel

import Prelude hiding (null)

infixr 3 :>
infixl 5 <:
infixr 5 <++>

-- | Although the name 'Vector' is borrowed from <ForSyDe-Atom.html#reekie95
-- [Reekie95]> since it is more suggestive in the context of process networks, the
-- 'Vector' type is in fact modeling an infinite list defined as a category in
-- <ForSyDe-Atom.html#skillicorn05 [Skillicorn05]>. According to this definition it
-- should be implemented as following:
--
-- > data Vector a = Null                   -- null element
-- >               | Unit a                 -- singleton vector
-- >               | Vector a <++> Vector a -- concatenate two vectors
--
-- This construction suggests the possibility of splitting a 'Vector' into multiple
-- parts and evaluating it in parallel. For simplicity and to ensure that the
-- structure is flat and homogeneous, 'Vector' is implemented using the same
-- constructors as a regular Haskell list (see below). When defining skeletons of
-- vectors we will not use the real constructors though, but the theoretical ones
-- defined above and provided as <#g:2 functions>. This way we align ForSyDe-Atom's
-- 'Vector' type with the skeleton theory and its theorems.
--
-- Another particularity of 'Vector' is that it instantiates the reduction atom '=\='
-- as a /right fold/, as it is the most efficient lazy implementation of lists. As a
-- consequence reduction is performed __/from right to left/__. This is noticed
-- especially in the case of pipeline-based skeletons (see definition of
-- 'ForSyDe.Atom.Skel.pipe' as a reduction with the right-associative composition
-- operator '.') is performed from right to left. Thus for 'reduce'-based skeletons
-- (e.g. 'prefix', 'suffix', 'recur', 'cascade', 'mesh') the result vectors shall be
-- read from end to beginning.
data Vector a = Null
              -- ^ Null element. Terminates a vector.
              | a :> (Vector a)
              -- ^ appends an element at the head of a vector.
              deriving (Vector a -> Vector a -> Bool
(Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Bool) -> Eq (Vector a)
forall a. Eq a => Vector a -> Vector a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector a -> Vector a -> Bool
$c/= :: forall a. Eq a => Vector a -> Vector a -> Bool
== :: Vector a -> Vector a -> Bool
$c== :: forall a. Eq a => Vector a -> Vector a -> Bool
Eq)

--------------------
-- "Constructors" --
--------------------

-- | Constructs a null vector.
--
-- >>> null
-- <>
null :: Vector a
null = Vector a
forall a. Vector a
Null

-- | Constructs a singleton vector.
--
-- >>> unit 1
-- <1>
unit :: a -> Vector a
unit a :: a
a = a
a a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a
forall a. Vector a
Null

-- | Constructs a vector by appending two existing vectors.
--
-- >>> unit 1 <++> unit 2
-- <1,2>
Null    <++> :: Vector a -> Vector a -> Vector a
<++> ys :: Vector a
ys = Vector a
ys
(x :: a
x:>xs :: Vector a
xs) <++> ys :: Vector a
ys = a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> (Vector a
xs Vector a -> Vector a -> Vector a
<++> Vector a
ys) 

---------------
-- Instances --
---------------

-- | Provides an implementation for '=.='.
instance Functor Vector where
  fmap :: (a -> b) -> Vector a -> Vector b
fmap _ Null   = Vector b
forall a. Vector a
Null
  fmap f :: a -> b
f (x :: a
x:>xs :: Vector a
xs) = a -> b
f a
x b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Vector a
xs


-- | Provides an implementation for '=*='.
instance Applicative Vector where
  pure :: a -> Vector a
pure x :: a
x = a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  _         <*> :: Vector (a -> b) -> Vector a -> Vector b
<*> Null      = Vector b
forall a. Vector a
Null
  Null      <*> _         = Vector b
forall a. Vector a
Null
  (f :: a -> b
f :> fs :: Vector (a -> b)
fs) <*> (x :: a
x :> xs :: Vector a
xs) = a -> b
f a
x b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
:> Vector (a -> b)
fs Vector (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector a
xs

-- | Provides an implementation for '=\='.
instance Foldable Vector where
  foldr :: (a -> b -> b) -> b -> Vector a -> b
foldr k :: a -> b -> b
k z :: b
z = Vector a -> b
go
    where go :: Vector a -> b
go Null    = b
z
          go (y :: a
y:>ys :: Vector a
ys) = a
y a -> b -> b
`k` Vector a -> b
go Vector a
ys

-- | Ensures that 'Vector' is a structure associated with the Skeleton Layer.
instance Skeleton Vector where
  =.= :: (a -> b) -> Vector a -> Vector b
(=.=) = (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)
  =*= :: Vector (a -> b) -> Vector a -> Vector b
(=*=) = Vector (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  _ =\= :: (a -> a -> a) -> Vector a -> a
=\= Null   = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "[Skel.Vector] cannot reduce empty vector" 
  f :: a -> a -> a
f =\= v :: Vector a
v      = (a -> a -> a) -> Vector a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
f Vector a
v
  Null =<<= :: Vector (a -> a) -> a -> a
=<<= s :: a
s = a
s
  ps :: Vector (a -> a)
ps   =<<= s :: a
s = (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((a -> a) -> (a -> a) -> a -> a) -> Vector (a -> a) -> a -> a
forall (c :: * -> *) a. Skeleton c => (a -> a -> a) -> c a -> a
=\= Vector (a -> a)
ps (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
s
  first :: Vector a -> a
first (x :: a
x:>_) = a
x

-- | The vector 1 :> 2 :> Null is represented as \<1,2\>.
instance (Show a) => Show (Vector a) where
  showsPrec :: Int -> Vector a -> ShowS
showsPrec p :: Int
p = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>1) (ShowS -> ShowS) -> (Vector a -> ShowS) -> Vector a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> ShowS
forall a. Show a => Vector a -> ShowS
showVector
    where
      showVector :: Vector a -> ShowS
showVector (x :: a
x :> xs :: Vector a
xs)  = Char -> ShowS
showChar '<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
showEvent a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> ShowS
forall a. Show a => Vector a -> ShowS
showVector' Vector a
xs
      showVector (Vector a
Null)     = Char -> ShowS
showChar '<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '>'
      showVector' :: Vector a -> ShowS
showVector' (x :: a
x :> xs :: Vector a
xs) = Char -> ShowS
showChar ',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
showEvent a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> ShowS
showVector' Vector a
xs
      showVector' (Vector a
Null)    = Char -> ShowS
showChar '>'
      showEvent :: a -> ShowS
showEvent x :: a
x           = a -> ShowS
forall a. Show a => a -> ShowS
shows a
x

-- | The vector 1 :> 2 :> Null is read using the string \"\<1,2\>\".
instance (Read a) => Read (Vector a) where
  readsPrec :: Int -> ReadS (Vector a)
readsPrec d :: Int
d = Bool -> ReadS (Vector a) -> ReadS (Vector a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
dInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>1) ReadS (Vector a)
readVecSigtart
    where
      readVecSigtart :: ReadS (Vector a)
readVecSigtart = (\ a :: [Char]
a -> [(Vector a
xs,[Char]
c) | ("<",b :: [Char]
b) <- ReadS [Char]
lex [Char]
a , (xs :: Vector a
xs,c :: [Char]
c) <- ReadS (Vector a)
forall a. Read a => [Char] -> [(Vector a, [Char])]
readVector (',' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
b) [(Vector a, [Char])]
-> [(Vector a, [Char])] -> [(Vector a, [Char])]
forall a. [a] -> [a] -> [a]
++ ReadS (Vector a)
forall a. [Char] -> [(Vector a, [Char])]
readNull [Char]
b])
      readVector :: [Char] -> [(Vector a, [Char])]
readVector r :: [Char]
r   = [Char] -> [(Vector a, [Char])]
readEvent [Char]
r [(Vector a, [Char])]
-> [(Vector a, [Char])] -> [(Vector a, [Char])]
forall a. [a] -> [a] -> [a]
++ [Char] -> [(Vector a, [Char])]
forall a. [Char] -> [(Vector a, [Char])]
readNull [Char]
r
      readEvent :: [Char] -> [(Vector a, [Char])]
readEvent a :: [Char]
a    = [(a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> Vector a
xs,[Char]
d) | (",",b :: [Char]
b) <- ReadS [Char]
lex [Char]
a , (x :: a
x,c :: [Char]
c) <- ReadS a
forall a. Read a => ReadS a
reads [Char]
b , (xs :: Vector a
xs,d :: [Char]
d) <- [Char] -> [(Vector a, [Char])]
readVector [Char]
c]
      readNull :: [Char] -> [(Vector a, [Char])]
readNull a :: [Char]
a     = [(Vector a
forall a. Vector a
Null,[Char]
b) | (">",b :: [Char]
b) <- ReadS [Char]
lex [Char]
a]


---------------
-- Utilities --
---------------

-- | Converts a list to a vector.
vector :: [a] -> Vector a
vector []     = Vector a
forall a. Vector a
Null
vector (x :: a
x:xs :: [a]
xs) = a
x a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
:> ([a] -> Vector a
vector [a]
xs)

-- | Converts a vector to a list.
fromVector :: Vector a -> [a]
fromVector Null    = []
fromVector (x :: a
x:>xs :: Vector a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Vector a -> [a]
fromVector Vector a
xs

-- | Creates the infinite vector:
--
-- > <1,2,3,4,...>
--
-- Used mainly for operation on indexes.
indexes :: Vector Int
indexes :: Vector Int
indexes = [Int] -> Vector Int
forall a. [a] -> Vector a
vector [1..]

-- | Returns @True@ if the argument is a null vector.
isNull :: Vector a -> Bool
isNull Null = Bool
True
isNull _    = Bool
False

-- | Appends an element at the end of a vector.
xs :: Vector a
xs <: :: Vector a -> a -> Vector a
<: x :: a
x = Vector a
xs Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
<++> a -> Vector a
forall a. a -> Vector a
unit a
x