fixed-vector-2.0.0.0: test/inspect.hs

{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fplugin=Test.Tasty.Inspection.Plugin #-}
{-# OPTIONS_GHC -dsuppress-idinfo #-}
module Main where

import Test.Tasty
import Test.Tasty.Inspection

import Data.Vector.Fixed           qualified as F
import Data.Vector.Fixed.Unboxed   qualified as FU
import Data.Vector.Fixed.Boxed     qualified as FB
import Data.Vector.Fixed.Primitive qualified as FP

import Inspect.Obligations



simple_fusion_FU :: Int -> Int
simple_fusion_FU n = F.sum $ F.generate @FU.Vec3 (*n)

simple_fusion_FB :: Int -> Int
simple_fusion_FB n = F.sum $ F.generate @FB.Vec3 (*n)

simple_fusion_FP :: Int -> Int
simple_fusion_FP n = F.sum $ F.generate @FP.Vec3 (*n)

fuse_mapM_ :: IO ()
fuse_mapM_ = F.mapM_ print (F.mk3 1 2 3 :: FU.Vec3 Double)

fuse_zipWith :: Int -> Int
fuse_zipWith n = F.sum $ F.zipWith (*) v u
  where v,u :: FU.Vec3 Int
        v = F.generate  (*2)
        u = F.replicate n

fuse_zipWith_self :: Int -> Int
fuse_zipWith_self n = F.sum $ F.zipWith (*) u u
  where u :: FU.Vec3 Int
        u = F.replicate n

-- More involved example with zipWith. It stresses optimizer and could be
-- used as a benchmark for optimization of compilation speed.
fuse_zipWithParam :: FP.Vec 3 Int -> FP.Vec 3 Int -> FP.Vec 3 Int -> Int
fuse_zipWithParam v1 v2 v3 = F.sum v12 + F.sum v13 + F.sum v23 where
  v12 = F.zipWith (*) v1 v2
  v13 = F.zipWith (*) v1 v3
  v23 = F.zipWith (*) v2 v3

simple_foldl1 :: FP.Vec 4 Int -> Int
simple_foldl1 = F.foldl1 (+) . F.map (\n -> n*n)


----------------------------------------------------------------
-- Tests
----------------------------------------------------------------

main :: IO ()
main = defaultMain $ testGroup "inspect"
  [ $(inspectObligations [ hasNoTypeClasses
                         , noArrayAlloc
                         ] 'simple_fusion_FU)
  , $(inspectObligations [ hasNoTypeClasses
                         , noArrayAlloc
                         ] 'simple_fusion_FB)
  , $(inspectObligations [ hasNoTypeClasses
                         , noArrayAlloc
                         ] 'simple_fusion_FP)
  , $(inspectObligations [ hasNoTypeClasses
                         , noArrayAlloc
                         ] 'fuse_mapM_)
  , testGroup "zipWith"
    -- NOTE: zipWith uses lists internally but they should get
    --       optimized away. Thus check that lists don't occur in core
    [ $(inspectObligations [ hasNoTypeClasses
                           , flip hasNoType ''[]
                           , noArrayAlloc
                           ] 'fuse_zipWith)
    , $(inspectObligations [ hasNoTypeClasses
                           , flip hasNoType ''[]
                           -- FIXME: Does not fuse when used nonlinearly
                           -- , noArrayAlloc
                           ] 'fuse_zipWith_self)
    , $(inspectObligations [ hasNoTypeClasses
                           , flip hasNoType ''[]
                           , noArrayAlloc
                           ] 'fuse_zipWithParam)
    , $(inspectObligations [ hasNoTypeClasses
                           , noArrayAlloc
                           ] 'simple_foldl1)
    ]
  ]