test

wasshoi.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

import           Control.Applicative
import qualified Data.Vector as V
import           Prelude hiding (zipWith)

class Zippable f where
  zipWith :: (a->b->c) -> f a -> f b -> f c

instance Zippable V.Vector where
  zipWith = V.zipWith

data W f a
  = Scalar a
  | Array (f a) deriving (Eq, Show)

instance (Functor f) => Functor (W f) where
  fmap f (Scalar x) = Scalar (f x)
  fmap f (Array xs) = Array (fmap f xs)

instance (Functor f, Zippable f, Functor (W f)) => Applicative (W f) where
  pure = Scalar
  (Scalar f) <*> (Scalar x) = Scalar (f x)
  (Scalar f) <*> (Array xs) = Array (fmap f xs)
  (Array fs) <*> (Scalar x) = Array (fmap ($x) fs)
  (Array fs) <*> (Array xs) = Array (zipWith ($) fs xs)

instance (Num a, Applicative (W f)) => (Num (W f a)) where
  (+)         = liftA2 (+)
  (-)         = liftA2 (-)
  (*)         = liftA2 (*)
  abs         = liftA abs
  signum      = liftA signum
  fromInteger = pure . fromInteger

backend :: (f a -> f a) -> W f a -> W f a
backend func (Scalar x) = undefined
backend func (Array xs) = Array (func xs)

xs, ys, zs :: W V.Vector Int
xs = Array $ V.fromList [1,2,3]
ys = Array $ V.fromList [4,5,6]
zs = Array $ V.fromList [7,8,9]


main = do
  print $  2 * (negate ys - 3 * xs) + 8 * zs
  print $  (backend V.reverse) xs * ys