{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-}

-- | A crude implementation of the ScanVectorMachine class using
--   @Data.Array.IArray@; no parallelism.  Warning: outrageously
--   inefficient code ahead!

module Control.Parallel.ScanVectorMachine.SerialScanVectorMachine(SSVM) where
import Data.Array.IArray
import Control.Parallel.ScanVectorMachine.ScanVectorMachine as SVM

newtype SSVM e = SSVM { unSSVM :: Array e e }

-- Array zip
azip :: Ix idx => Array idx e1 -> Array idx e2 -> Array idx (e1,e2)
azip x y = array (start, end) $ map (\i -> (i,((x!i),(y!i)))) (range (start,end))
  where
   (xmin,xmax) = bounds x
   (ymin,ymax) = bounds y
   start       = max xmin ymin
   end         = min xmax ymax

op2func :: (Ix e, Ord e, Num e) => SVM.Op -> (e -> e -> e)
op2func And   x y = if x/=0 && y/=0 then 1 else 0
op2func Or    x y = if x/=0 || y/=0 then 1 else 0
op2func Min   x y = if x < y then x else y
op2func Max   x y = if x > y then x else y
op2func Plus  x y = x+y
op2func Times x y = x*y

instance (Ix e, Show e) => Show (SSVM e) where
  show (SSVM a) = show $ elems a

instance (Enum e, Ix e, Ord e, Num e) => SVM.ScanVectorMachine SSVM e where
  neg         (SSVM a)                   = SSVM $ amap (\x -> if x==0 then 1 else 0) a
  leq         (SSVM a) (SSVM b)          = SSVM $ amap (\(x,y) -> if x <= y then 1 else 0) $ azip a b
  op       op (SSVM a) (SSVM b)          = SSVM $ amap (uncurry $ op2func op) $ azip a b
  select      (SSVM b) (SSVM x) (SSVM y) = SSVM $ amap (\(b,(x,y)) -> if b/=0 then x else y) $ azip b (azip x y)
  permute     (SSVM a) (SSVM i)          = SSVM $ array (bounds a) $ zip (elems i) (elems a)
  insert      (SSVM a) pos v             = SSVM $ a // [(pos,v)]
  extract     (SSVM a) pos               = a ! pos
  distribute  v len                      = SSVM $ array (0,(len-1)) [ (i,v) | i <- [0..(len-1)] ]
  length      (SSVM a)                   = max 0 (end-start+fromInteger 1) where (start,end) = bounds a
  scan     op (SSVM a)                   = SSVM $ array (bounds a) $ (0,0):(drop 1 result)
                                             where
                                               result                  = fst $ foldl mapfunc ([],0) (assocs a)
                                               mapfunc (ret,acc) (i,e) = let acc' = op2func op e acc in (((i+1,acc'):ret),acc')