ExtractSurface.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module ExtractSurface (extractSurface') where

import qualified Prelude as P

import Data.Word
import Data.Array.Accelerate

s333 :: Stencil3x3x3 Bool -> Exp Word8
s333 (((_,a,b)
      ,(_,c,d)
      ,(_,_,_))
     ,((_,e,f)
      ,(_,g,h)
      ,(_,_,_))
     ,((_,_,_)
      ,(_,_,_)
      ,(_,_,_))) = b2w a*1  + b2w b*2  + b2w c*4  + b2w d*8
                 + b2w e*16 + b2w f*32 + b2w g*64 + b2w h*128
  where b2w b = cond b (constant 1) (constant 0)

extractSurface' 
  :: Acc (Array (Z:.Int:.Int:.Int) Word8)
  -> Acc (Array (Z:.Int:.Int:.Int) Word8)
extractSurface' = backpermute (constant (Z:.15:.15:.15)) P.id 
                . stencil s333 clamp 
                . map (/= constant 0)

issue399.cabal

name:                issue399
version:             0.1.0.0
-- synopsis:
-- description:
homepage:            https://github.com/tmcdonell/issue399#readme
license:             BSD3
-- license-file:        LICENSE
author:              Trevor L. McDonell
maintainer:          Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>
copyright:           BSD3
-- category:            Web
-- extra-source-files:  README.md
build-type:          Simple
cabal-version:       >=1.10

executable issue399
  default-language:     Haskell2010
  main-is:              Main.hs
  other-modules:
      ExtractSurface

  ghc-options:
      -threaded
      -rtsopts
      -fplugin=Data.Array.Accelerate.LLVM.Native.Plugin

  build-depends:
        base
      , accelerate
      , accelerate-llvm-native

source-repository head
  type:     git
  location: https://github.com/tmcdonell/issue399

-- vim: nospell

Main.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Main (main) where

import ExtractSurface

import Data.Array.Accelerate.LLVM.Native
import Data.Array.Accelerate (Z (..),(:.) (..),Array,fromList,toList,use)
import Data.Word

myChunk :: [Word8]
myChunk = [if z*z > x*x + y*y then 1 else 0 | x <- [0..15], y <- [0..15], z <- [0..15]]

extractSurface :: Array (Z:.Int:.Int:.Int) Word8 -> Array (Z:.Int:.Int:.Int) Word8
extractSurface = $(runQ extractSurface')

main :: IO ()
main = print $ toList $ extractSurface $ fromList (Z:.16:.16:.16) myChunk

Setup.hs

import Distribution.Simple
main = defaultMain

stack.yaml

# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/

# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
#  name: custom-snapshot
#  location: "./custom-snapshot.yaml"
resolver: nightly-2017-10-13

# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
#    git: https://github.com/commercialhaskell/stack.git
#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#   extra-dep: true
#  subdirs:
#  - auto-update
#  - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps: []

# Override default flag values for local packages and extra-deps
flags: {}

# Extra package databases containing global packages
extra-package-dbs: []

# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.5"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor