├── .github
└── workflows
│ └── ci.yml
├── .gitignore
├── CHANGELOG.md
├── LICENSE
├── README.md
├── assets
└── construction_1f6a7.png
├── cabal.project
├── cabal.project.local
├── construction.png
├── example
├── Example01.hs
├── GettingStarted.hs
└── MinimalGPU.hs
├── flake.lock
├── flake.nix
├── fourmolu.yaml
├── halide-JuicyPixels
├── LICENSE
├── README.md
├── halide-JuicyPixels.cabal
├── src
│ └── Language
│ │ └── Halide
│ │ └── JuicyPixels.hs
└── test
│ ├── Main.hs
│ └── cat.jpg
├── halide-arrayfire
├── LICENSE
├── README.md
├── halide-arrayfire.cabal
├── src
│ └── Language
│ │ └── Halide
│ │ └── ArrayFire.hs
└── test
│ └── Spec.hs
├── halide-haskell.cabal
├── hie.yaml
├── nix
├── arrayfire-no-download.patch
├── arrayfire.nix
├── forge-no-download.patch
├── forge.nix
└── halide.nix
├── print_loop_nest.patch
├── shell.nix
├── src
└── Language
│ ├── Halide.hs
│ └── Halide
│ ├── BoundaryConditions.hs
│ ├── Buffer.hs
│ ├── Context.hs
│ ├── Dimension.hs
│ ├── Expr.hs
│ ├── Func.hs
│ ├── Kernel.hs
│ ├── LoopLevel.hs
│ ├── Prelude.hs
│ ├── RedundantConstraints.hs
│ ├── Schedule.hs
│ ├── Target.hs
│ ├── Trace.hs
│ ├── Type.hs
│ └── Utils.hs
├── template
├── LICENSE
├── README.md
├── flake.lock
├── flake.nix
├── halide-haskell-playground.cabal
├── src
│ └── Playground.hs
└── test
│ └── Main.hs
├── test-readme
├── LICENSE
├── README.lhs
└── halide-readme.cabal
├── test
├── Language
│ └── Halide
│ │ ├── BoundaryConditionsSpec.hs
│ │ ├── BufferSpec.hs
│ │ ├── ExprSpec.hs
│ │ ├── FuncSpec.hs
│ │ ├── KernelSpec.hs
│ │ ├── LoopLevelSpec.hs
│ │ ├── ScheduleSpec.hs
│ │ └── TargetSpec.hs
├── Spec.hs
├── Utils.hs
├── exceptions.cpp
└── write_to_ostream.cpp
└── tutorials
├── 01-Basics
├── LICENSE
├── README.lhs
├── README.md
└── halide-tutorial01.cabal
├── 03-Inspecting
├── README.lhs
├── README.md
├── gradient.html
└── halide-tutorial03.cabal
├── 04-Debugging
├── README.lhs
├── README.md
└── halide-tutorial04.cabal
├── 05-Scheduling
├── LICENSE
├── README.lhs
├── README.md
├── halide-tutorial05.cabal
└── test.hs
└── README.md
/.github/workflows/ci.yml:
--------------------------------------------------------------------------------
1 | name: CI
2 |
3 | # Trigger the workflow on push or pull request, but only for the master branch
4 | on:
5 | pull_request:
6 | push:
7 | branches: [master]
8 |
9 | jobs:
10 | build:
11 | strategy:
12 | matrix:
13 | ghc: ['927', '945'] # Not all dependencies support 9.6.1 yet
14 | os: ['ubuntu-latest', 'macos-latest']
15 | runs-on: ${{ matrix.os }}
16 | name: Build with GHC ${{ matrix.ghc }} on ${{ matrix.os }}
17 | steps:
18 | - uses: actions/checkout@v3
19 | - uses: cachix/install-nix-action@v20
20 | - uses: cachix/cachix-action@v12
21 | with:
22 | name: halide-haskell
23 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
24 | - name: Build
25 | run: |
26 | nix build \
27 | --accept-flake-config \
28 | --print-build-logs \
29 | .#ghc${{ matrix.ghc }}.halide-haskell
30 | - name: Examples & Tutorials
31 | run: |
32 | nix build --accept-flake-config --print-build-logs .#ghc${{ matrix.ghc }}.halide-all
33 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | ### Haskell
2 | dist
3 | dist-*
4 | cabal-dev
5 | *.o
6 | *.hi
7 | *.chi
8 | *.chs.h
9 | *.dyn_o
10 | *.dyn_hi
11 | *.prof
12 | *.aux
13 | *.hp
14 | *.eventlog
15 | .virtualenv
16 | .hsenv
17 | .hpc
18 | .cabal-sandbox/
19 | cabal.sandbox.config
20 | cabal.config
21 | .ghc.environment.*
22 | .HTF/
23 | # Stack
24 | .stack-work/
25 | stack.yaml.lock
26 |
27 | ### IDE/support
28 | # Vim
29 | [._]*.s[a-v][a-z]
30 | [._]*.sw[a-p]
31 | [._]s[a-v][a-z]
32 | [._]sw[a-p]
33 | *~
34 | tags
35 |
36 | # IntellijIDEA
37 | .idea/
38 | .ideaHaskellLib/
39 | *.iml
40 |
41 | # Atom
42 | .haskell-ghc-mod.json
43 |
44 | # VS
45 | .vscode/
46 |
47 | # Emacs
48 | *#
49 | .dir-locals.el
50 | TAGS
51 |
52 | # other
53 | .DS_Store
54 |
55 | # Halide
56 | lib*.a
57 | app/libfoo.h
58 | *.registration.cpp
59 | *_generator
60 | third_party/Halide-*
61 | result
62 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Changelog
2 |
3 | `halide-haskell` uses [PVP Versioning][1].
4 | The changelog is available [on GitHub][2].
5 |
6 | ## 0.0.0.0
7 |
8 | * Initially created.
9 |
10 | [1]: https://pvp.haskell.org
11 | [2]: https://github.com/twesterhout/halide-haskell/releases
12 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | BSD 3-Clause License
2 |
3 | Copyright (c) 2021, Tom Westerhout
4 | All rights reserved.
5 |
6 | Redistribution and use in source and binary forms, with or without
7 | modification, are permitted provided that the following conditions are met:
8 |
9 | 1. Redistributions of source code must retain the above copyright notice, this
10 | list of conditions and the following disclaimer.
11 |
12 | 2. Redistributions in binary form must reproduce the above copyright notice,
13 | this list of conditions and the following disclaimer in the documentation
14 | and/or other materials provided with the distribution.
15 |
16 | 3. Neither the name of the copyright holder nor the names of its
17 | contributors may be used to endorse or promote products derived from
18 | this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | test-readme/README.lhs
--------------------------------------------------------------------------------
/assets/construction_1f6a7.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/twesterhout/halide-haskell/7e88a54bc5009ebcdd122c821aa74bd0fcfd5205/assets/construction_1f6a7.png
--------------------------------------------------------------------------------
/cabal.project:
--------------------------------------------------------------------------------
1 | packages: .
2 | , test-readme
3 | , tutorials/01-Basics
4 | , tutorials/03-Inspecting
5 | , tutorials/04-Debugging
6 | , tutorials/05-Scheduling
7 | , halide-JuicyPixels
8 | , halide-arrayfire
9 |
--------------------------------------------------------------------------------
/cabal.project.local:
--------------------------------------------------------------------------------
1 | ignore-project: False
2 | write-ghc-environment-files: always
3 | tests: True
4 | test-options: "--color"
5 | test-show-details: streaming
6 | package halide-haskell
7 | ghc-options: -g2
8 |
--------------------------------------------------------------------------------
/construction.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/twesterhout/halide-haskell/7e88a54bc5009ebcdd122c821aa74bd0fcfd5205/construction.png
--------------------------------------------------------------------------------
/example/Example01.hs:
--------------------------------------------------------------------------------
1 | import Control.Monad (when)
2 | import Language.Halide
3 |
4 | main :: IO ()
5 | main = do
6 | let !host = hostTarget
7 | putStrLn $ "[+] host target is " <> show host
8 | when (hostSupportsTargetDevice (setFeature FeatureOpenCL host)) $ do
9 | putStrLn "[+] OpenCL is supported! Testing ..."
10 | testOpenCL
11 | when (hostSupportsTargetDevice (setFeature FeatureCUDA host)) $ do
12 | putStrLn "[+] CUDA is supported! Testing ..."
13 | testCUDA
--------------------------------------------------------------------------------
/example/GettingStarted.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Data.Vector.Storable qualified as S
4 | import Data.Vector.Storable.Mutable qualified as SM
5 | import Language.Halide
6 | import System.IO.Unsafe (unsafePerformIO)
7 |
8 | mkVectorPlus :: forall a. (IsHalideType a, Num a) => IO (S.Vector a -> S.Vector a -> S.Vector a)
9 | mkVectorPlus = do
10 | -- First, compile the kernel
11 | kernel <- compile $ \(buffer "a" -> a) b -> do
12 | -- Create an index variable
13 | i <- mkVar "i"
14 | -- Define the resulting function. We call it "out".
15 | -- In pseudocode it's equivalent to the following: out[i] = a[i] + b[i]
16 | define "out" i $ a ! i + b ! i
17 | -- Create a Haskell function that will invoke the kernel
18 | pure $ \v1 v2 -> unsafePerformIO $ do
19 | out <- SM.new (S.length v1)
20 | withHalideBuffer @1 @a v1 $ \a ->
21 | withHalideBuffer @1 @a v2 $ \b ->
22 | withHalideBuffer @1 @a out $ \out' ->
23 | kernel a b out'
24 | S.unsafeFreeze out
25 |
26 | main :: IO ()
27 | main = do
28 | let a, b :: S.Vector Float
29 | a = S.fromList [1, 2, 3]
30 | b = S.fromList [4, 5, 6]
31 | vectorPlus <- mkVectorPlus
32 | print (vectorPlus a b)
33 |
--------------------------------------------------------------------------------
/example/MinimalGPU.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Control.Monad (unless, void)
4 | import Language.Halide
5 |
6 | main :: IO ()
7 | main = do
8 | [x, y, xo, xi, yo, yi] <- mapM mkVar ["x", "y", "xo", "xi", "yo", "yi"]
9 | f <- define "f" (x, y) $ x + y
10 |
11 | void $
12 | split TailAuto x (xo, xi) 16 f
13 | >>= split TailAuto y (yo, yi) 16
14 | >>= reorder [xi, yi, xo, yo]
15 | >>= gpuBlocks DeviceDefaultGPU (xo, yo)
16 | >>= gpuThreads DeviceDefaultGPU (xi, yi)
17 |
18 | case gpuTarget of
19 | Nothing -> putStrLn "no GPU target found; skipping ..."
20 | Just target -> do
21 | r <- realizeOnTarget (setFeature FeatureDebug target) f [32, 32] peekToList
22 | let expected = [[i + j | i <- [0 .. 31]] | j <- [0 .. 31]]
23 | unless (r == expected) . error $
24 | "wrong result:"
25 | <> "\n got: "
26 | <> show r
27 | <> ",\n but expected: "
28 | <> show expected
29 |
--------------------------------------------------------------------------------
/flake.lock:
--------------------------------------------------------------------------------
1 | {
2 | "nodes": {
3 | "arrayfire-haskell": {
4 | "flake": false,
5 | "locked": {
6 | "lastModified": 1681826721,
7 | "narHash": "sha256-O2pwFrlYYf7//fRQd+CvG+y6FuERI+94jXx3uCcvOfY=",
8 | "owner": "twesterhout",
9 | "repo": "arrayfire-haskell",
10 | "rev": "6cb10ef1a4c3077f05436efca4f06887b4750c1a",
11 | "type": "github"
12 | },
13 | "original": {
14 | "owner": "twesterhout",
15 | "ref": "main",
16 | "repo": "arrayfire-haskell",
17 | "type": "github"
18 | }
19 | },
20 | "arrayfire-nix": {
21 | "inputs": {
22 | "flake-utils": [
23 | "flake-utils"
24 | ],
25 | "nixgl": "nixgl",
26 | "nixpkgs": [
27 | "nixpkgs"
28 | ]
29 | },
30 | "locked": {
31 | "lastModified": 1686498501,
32 | "narHash": "sha256-asJbLDtO+0ttSagYXccZF7vjCDiFAuSqiQFVsQ/TY04=",
33 | "owner": "twesterhout",
34 | "repo": "arrayfire-nix",
35 | "rev": "1b38c60ca202cfa536808a3d76c59639fedf7e2b",
36 | "type": "github"
37 | },
38 | "original": {
39 | "owner": "twesterhout",
40 | "repo": "arrayfire-nix",
41 | "type": "github"
42 | }
43 | },
44 | "flake-compat": {
45 | "flake": false,
46 | "locked": {
47 | "lastModified": 1673956053,
48 | "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=",
49 | "owner": "edolstra",
50 | "repo": "flake-compat",
51 | "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9",
52 | "type": "github"
53 | },
54 | "original": {
55 | "owner": "edolstra",
56 | "repo": "flake-compat",
57 | "type": "github"
58 | }
59 | },
60 | "flake-utils": {
61 | "inputs": {
62 | "systems": "systems"
63 | },
64 | "locked": {
65 | "lastModified": 1687171271,
66 | "narHash": "sha256-BJlq+ozK2B1sJDQXS3tzJM5a+oVZmi1q0FlBK/Xqv7M=",
67 | "owner": "numtide",
68 | "repo": "flake-utils",
69 | "rev": "abfb11bd1aec8ced1c9bb9adfe68018230f4fb3c",
70 | "type": "github"
71 | },
72 | "original": {
73 | "owner": "numtide",
74 | "repo": "flake-utils",
75 | "type": "github"
76 | }
77 | },
78 | "nix-filter": {
79 | "locked": {
80 | "lastModified": 1687178632,
81 | "narHash": "sha256-HS7YR5erss0JCaUijPeyg2XrisEb959FIct3n2TMGbE=",
82 | "owner": "numtide",
83 | "repo": "nix-filter",
84 | "rev": "d90c75e8319d0dd9be67d933d8eb9d0894ec9174",
85 | "type": "github"
86 | },
87 | "original": {
88 | "owner": "numtide",
89 | "repo": "nix-filter",
90 | "type": "github"
91 | }
92 | },
93 | "nixGL": {
94 | "inputs": {
95 | "flake-utils": [
96 | "flake-utils"
97 | ],
98 | "nixpkgs": [
99 | "nixpkgs"
100 | ]
101 | },
102 | "locked": {
103 | "lastModified": 1685908677,
104 | "narHash": "sha256-E4zUPEUFyVWjVm45zICaHRpfGepfkE9Z2OECV9HXfA4=",
105 | "owner": "guibou",
106 | "repo": "nixGL",
107 | "rev": "489d6b095ab9d289fe11af0219a9ff00fe87c7c5",
108 | "type": "github"
109 | },
110 | "original": {
111 | "owner": "guibou",
112 | "repo": "nixGL",
113 | "type": "github"
114 | }
115 | },
116 | "nixgl": {
117 | "inputs": {
118 | "flake-utils": [
119 | "arrayfire-nix",
120 | "flake-utils"
121 | ],
122 | "nixpkgs": [
123 | "arrayfire-nix",
124 | "nixpkgs"
125 | ]
126 | },
127 | "locked": {
128 | "lastModified": 1685908677,
129 | "narHash": "sha256-E4zUPEUFyVWjVm45zICaHRpfGepfkE9Z2OECV9HXfA4=",
130 | "owner": "guibou",
131 | "repo": "nixGL",
132 | "rev": "489d6b095ab9d289fe11af0219a9ff00fe87c7c5",
133 | "type": "github"
134 | },
135 | "original": {
136 | "owner": "guibou",
137 | "repo": "nixGL",
138 | "type": "github"
139 | }
140 | },
141 | "nixpkgs": {
142 | "locked": {
143 | "lastModified": 1686960236,
144 | "narHash": "sha256-AYCC9rXNLpUWzD9hm+askOfpliLEC9kwAo7ITJc4HIw=",
145 | "owner": "nixos",
146 | "repo": "nixpkgs",
147 | "rev": "04af42f3b31dba0ef742d254456dc4c14eedac86",
148 | "type": "github"
149 | },
150 | "original": {
151 | "owner": "nixos",
152 | "ref": "nixos-unstable",
153 | "repo": "nixpkgs",
154 | "type": "github"
155 | }
156 | },
157 | "root": {
158 | "inputs": {
159 | "arrayfire-haskell": "arrayfire-haskell",
160 | "arrayfire-nix": "arrayfire-nix",
161 | "flake-compat": "flake-compat",
162 | "flake-utils": "flake-utils",
163 | "nix-filter": "nix-filter",
164 | "nixGL": "nixGL",
165 | "nixpkgs": "nixpkgs"
166 | }
167 | },
168 | "systems": {
169 | "locked": {
170 | "lastModified": 1681028828,
171 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
172 | "owner": "nix-systems",
173 | "repo": "default",
174 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
175 | "type": "github"
176 | },
177 | "original": {
178 | "owner": "nix-systems",
179 | "repo": "default",
180 | "type": "github"
181 | }
182 | }
183 | },
184 | "root": "root",
185 | "version": 7
186 | }
187 |
--------------------------------------------------------------------------------
/flake.nix:
--------------------------------------------------------------------------------
1 | {
2 | description = "twesterhout/halide-haskell: Running Halide pipelines from Haskell";
3 |
4 | nixConfig = {
5 | extra-substituters = "https://halide-haskell.cachix.org";
6 | extra-trusted-public-keys = "halide-haskell.cachix.org-1:cFPqtShCsH4aNjn2q4PHb39Omtd/FWRhrkTBcSrtNKQ=";
7 | };
8 |
9 | inputs = {
10 | nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
11 | flake-utils.url = "github:numtide/flake-utils";
12 | nix-filter.url = "github:numtide/nix-filter";
13 | flake-compat = {
14 | url = "github:edolstra/flake-compat";
15 | # don't look for a flake.nix file in this repository
16 | # this tells Nix to retrieve this input as just source code
17 | flake = false;
18 | };
19 | # halide = {
20 | # url = "github:halide/Halide";
21 | # flake = false;
22 | # };
23 | arrayfire-nix = {
24 | url = "github:twesterhout/arrayfire-nix";
25 | inputs.flake-utils.follows = "flake-utils";
26 | inputs.nixpkgs.follows = "nixpkgs";
27 | };
28 | # inline-c = {
29 | # url = "github:twesterhout/inline-c";
30 | # flake = false;
31 | # };
32 | arrayfire-haskell = {
33 | url = "github:twesterhout/arrayfire-haskell/main";
34 | flake = false;
35 | };
36 | nixGL = {
37 | url = "github:guibou/nixGL";
38 | inputs.flake-utils.follows = "flake-utils";
39 | inputs.nixpkgs.follows = "nixpkgs";
40 | };
41 | };
42 |
43 | outputs = { nixpkgs, flake-utils, nix-filter, nixGL, ... }:
44 | let
45 | inherit (nixpkgs) lib;
46 | src = nix-filter.lib {
47 | root = ./.;
48 | include = [
49 | "src"
50 | "example"
51 | "test"
52 | "construction.png"
53 | "halide-haskell.cabal"
54 | "README.md"
55 | "test-readme/README.lhs"
56 | "LICENSE"
57 | ];
58 | };
59 | halide-haskell-for = pkgs: haskellPackages:
60 | let
61 | builder =
62 | { withIntelOpenCL
63 | , withCuda
64 | }:
65 | (haskellPackages.callCabal2nix "halide-haskell" src {
66 | Halide = pkgs.halide;
67 | }).overrideAttrs (attrs: rec {
68 | pname = attrs.pname
69 | + lib.optionalString withIntelOpenCL "-intel-ocl"
70 | + lib.optionalString withCuda "-cuda";
71 | name = "${pname}-${attrs.version}";
72 | nativeBuildInputs = attrs.nativeBuildInputs
73 | ++ lib.optional withIntelOpenCL pkgs.makeWrapper;
74 | propagatedBuildInputs = with pkgs;
75 | attrs.propagatedBuildInputs
76 | ++ lib.optionals withIntelOpenCL [ clinfo intel-ocl ocl-icd ]
77 | ++ lib.optional withCuda nixGL.packages.${system}.nixGLDefault;
78 | postInstall = (attrs.postInstall or "")
79 | + lib.optionalString withIntelOpenCL ''
80 | wrapProgram $out/bin/halide-haskell \
81 | --prefix LD_LIBRARY_PATH : ${pkgs.ocl-icd}/lib \
82 | --prefix OCL_ICD_VENDORS : ${pkgs.intel-ocl}/etc/OpenCL/vendors
83 | ''
84 | + lib.optionalString withCuda ''
85 | prog="$out/bin/halide-haskell"
86 | hidden="$(dirname "$prog")/.$(basename "$prog")"-wrapped
87 | mv "$prog" "$hidden"
88 | echo "#!${pkgs.stdenv.shell}" > "$prog"
89 | echo "exec ${pkgs.nixgl.auto.nixGLDefault}/bin/nixGL $hidden \"\$@\"" >> "$prog"
90 | chmod +x "$prog"
91 | '';
92 | # We set withIntelOpenCL and withCuda such that dev shells can determine whether
93 | # they need extra dependencies
94 | inherit withIntelOpenCL;
95 | inherit withCuda;
96 | });
97 | in
98 | lib.makeOverridable builder
99 | { withIntelOpenCL = false; withCuda = false; };
100 |
101 | with-markdown-unlit = hp: p: p.overrideAttrs (attrs: {
102 | nativeBuildInputs = (attrs.nativeBuildInputs or [ ]) ++ [ hp.markdown-unlit ];
103 | });
104 |
105 | overlayFor = args: self: super: {
106 | haskell = super.haskell // {
107 | packageOverrides = nixpkgs.lib.composeExtensions super.haskell.packageOverrides
108 | (hself: hsuper: rec {
109 | # arrayfire =
110 | # (hself.callCabal2nix "arrayfire" inputs.arrayfire-haskell.outPath {
111 | # af = pkgs.arrayfire;
112 | # }).overrideAttrs (attrs: {
113 | # configureFlags = (attrs.configureFlags or [ ]) ++ [ "-fdisable-default-paths" ];
114 | # });
115 | halide-haskell = (halide-haskell-for self hself).override args;
116 | halide-JuicyPixels =
117 | (hself.callCabal2nix "halide-JuicyPixels" ./halide-JuicyPixels { });
118 | halide-arrayfire =
119 | (hself.callCabal2nix "halide-arrayfire" ./halide-arrayfire { });
120 | halide-readme = with-markdown-unlit hself
121 | (hself.callCabal2nix "halide-readme" ./test-readme { });
122 | halide-tutorial01 = with-markdown-unlit hself
123 | (hself.callCabal2nix "halide-tutorial01" ./tutorials/01-Basics { });
124 | halide-tutorial03 = with-markdown-unlit hself
125 | (hself.callCabal2nix "halide-tutorial03" ./tutorials/03-Inspecting { });
126 | halide-tutorial04 = with-markdown-unlit hself
127 | (hself.callCabal2nix "halide-tutorial04" ./tutorials/04-Debugging { });
128 | halide-tutorial05 = with-markdown-unlit hself
129 | (hself.callCabal2nix "halide-tutorial05" ./tutorials/05-Scheduling { });
130 | halide-all = self.buildEnv {
131 | name = "halide-all";
132 | paths = [
133 | halide-haskell
134 | halide-JuicyPixels
135 | halide-readme
136 | halide-tutorial01
137 | halide-tutorial03
138 | halide-tutorial04
139 | halide-tutorial05
140 | ]; # ++ lib.optional self.stdenv.isLinux halide-arrayfire;
141 | };
142 | });
143 | };
144 | };
145 |
146 | devShellFor = pkgs:
147 | let
148 | ps = pkgs.haskellPackages;
149 | withIntelOpenCL = ps.halide-haskell.withIntelOpenCL;
150 | withCuda = ps.halide-haskell.withCuda;
151 | in
152 | ps.shellFor {
153 | packages = ps: with ps; [
154 | halide-haskell
155 | halide-JuicyPixels
156 | halide-readme
157 | halide-tutorial01
158 | halide-tutorial03
159 | halide-tutorial04
160 | halide-tutorial05
161 | ]; # ++ lib.optional pkgs.stdenv.isLinux halide-arrayfire;
162 | withHoogle = true;
163 | nativeBuildInputs = with pkgs; with ps; [
164 | # Building and testing
165 | cabal-install
166 | doctest
167 | markdown-unlit
168 | # Language servers
169 | haskell-language-server
170 | nil
171 | # Formatters
172 | fourmolu
173 | cabal-fmt
174 | nixpkgs-fmt
175 | # Previewing markdown files
176 | python3Packages.grip
177 | # For debugging Halide
178 | clang_14
179 | # gcc
180 | # zlib
181 | # gdb
182 | ]
183 | ++ lib.optional withIntelOpenCL clinfo
184 | ++ lib.optional withCuda pkgs.nixgl.auto.nixGLDefault;
185 | shellHook = ''
186 | export PROMPT_COMMAND=""
187 | export PS1='(nix) GHC ${ps.ghc.version} \w $ '
188 | export LD_LIBRARY_PATH=${pkgs.zlib}/lib:${pkgs.halide}/lib:$LD_LIBRARY_PATH
189 | '' + (if withIntelOpenCL then ''
190 | export LD_LIBRARY_PATH=${pkgs.ocl-icd}/lib:$LD_LIBRARY_PATH
191 | export OCL_ICD_VENDORS="${pkgs.intel-ocl}/etc/OpenCL/vendors"
192 | '' else "");
193 | };
194 |
195 | pkgsFor = system: args: import nixpkgs {
196 | inherit system;
197 | overlays = [
198 | nixGL.overlay
199 | (overlayFor args)
200 | ];
201 | config.allowUnfree =
202 | (args ? withIntelOpenCL) && args.withIntelOpenCL
203 | || (args ? withCuda) && args.withCuda;
204 | };
205 | in
206 | {
207 | packages = flake-utils.lib.eachDefaultSystemMap (system:
208 | with (pkgsFor system { }); {
209 | default = haskellPackages.halide-haskell;
210 | halide-haskell = haskellPackages.halide-haskell;
211 | halide-all = haskellPackages.halide-all;
212 | haskell = haskell.packages;
213 | });
214 |
215 | devShells = flake-utils.lib.eachDefaultSystemMap (system: {
216 | default = devShellFor (pkgsFor system { });
217 | cuda = devShellFor (pkgsFor system { withCuda = true; });
218 | intel-ocl = devShellFor (pkgsFor system { withIntelOpenCL = true; });
219 | });
220 |
221 | overlays = {
222 | default = overlayFor { };
223 | cuda = overlayFor { withCuda = true; };
224 | intel-ocl = overlayFor { withIntelOpenCL = true; };
225 | };
226 | templates.default = {
227 | path = ./template;
228 | description = "A minimal Haskell project using halide-haskell";
229 | };
230 | };
231 | }
232 |
--------------------------------------------------------------------------------
/fourmolu.yaml:
--------------------------------------------------------------------------------
1 | indentation: 2
2 | function-arrows: leading
3 | comma-style: leading
4 | import-export-style: leading
5 | indent-wheres: true
6 | record-brace-space: true
7 | newlines-between-decls: 1
8 | haddock-style: single-line
9 | haddock-style-module: single-line
10 | let-style: auto
11 | in-style: right-align
12 | unicode: never
13 | respectful: true
14 | fixities: []
15 |
--------------------------------------------------------------------------------
/halide-JuicyPixels/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2023, twesterhout
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of twesterhout nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 |
--------------------------------------------------------------------------------
/halide-JuicyPixels/README.md:
--------------------------------------------------------------------------------
1 |
2 | halide-JuicyPixels
3 |
4 |
5 |
6 |
7 |
8 | [](LICENSE)
9 |
10 | [](https://github.com/twesterhout/halide-haskell/actions/workflows/ci.yml)
11 | [](https://hackage.haskell.org/package/halide-JuicyPixels)
12 |
13 |
14 |
15 | This package integrates
16 | [halide-haskell](https://github.com/twesterhout/halide-haskell/) with
17 | [JuicyPixels](https://github.com/Twinside/Juicy.Pixels) by implementing
18 | instances of `IsHalideBuffer` for `Image` and `MutableImage` types. See [this
19 | test](test/Main.hs) for an example usage.
20 |
--------------------------------------------------------------------------------
/halide-JuicyPixels/halide-JuicyPixels.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-JuicyPixels
3 | version: 0.0.2.1
4 | synopsis: Integration between Halide and JuicyPixels
5 | description:
6 | This package provides instances of [Language.Halide.IsHalideBuffer](https://hackage.haskell.org/package/halide-haskell/docs/Language-Halide.html#t:IsHalideBuffer)
7 | for image types from the [JuicyPixels](https://hackage.haskell.org/package/JuicyPixels) library.
8 |
9 | homepage: https://github.com/twesterhout/halide-haskell
10 | bug-reports: https://github.com/twesterhout/halide-haskell/issues
11 | license: BSD-3-Clause
12 | license-file: LICENSE
13 | author: Tom Westerhout
14 | maintainer:
15 | Tom Westerhout <14264576+twesterhout@users.noreply.github.com>
16 |
17 | category: Language
18 | copyright: 2022-2023 Tom Westerhout
19 | build-type: Simple
20 | extra-doc-files: README.md
21 | tested-with: GHC ==9.2.7 || ==9.4.4 || ==9.4.5
22 |
23 | common setup
24 | ghc-options: -Wall
25 | default-language: GHC2021
26 | default-extensions:
27 | DataKinds
28 | InstanceSigs
29 | LambdaCase
30 | OverloadedRecordDot
31 | TypeFamilies
32 |
33 | library
34 | import: setup
35 | exposed-modules: Language.Halide.JuicyPixels
36 | build-depends:
37 | , base >=4.16.0.0 && <5
38 | , halide-haskell >=0.0.2.0 && <0.1.0.0
39 | , JuicyPixels >=3.3.0 && <4
40 | , vector >=0.12.3.0 && <0.13
41 |
42 | ghc-options: -Wno-orphans
43 | hs-source-dirs: src
44 |
45 | test-suite halide-JuicyPixels-test
46 | import: setup
47 | type: exitcode-stdio-1.0
48 | hs-source-dirs: test
49 | main-is: Main.hs
50 | build-depends:
51 | , base
52 | , halide-haskell
53 | , halide-JuicyPixels
54 | , hspec >=2.9.7 && <3
55 | , JuicyPixels
56 |
--------------------------------------------------------------------------------
/halide-JuicyPixels/src/Language/Halide/JuicyPixels.hs:
--------------------------------------------------------------------------------
1 | -- |
2 | -- Module : Language.Halide.JuicyPixels
3 | -- Copyright : (c) Tom Westerhout, 2023
4 | --
5 | -- This package allows you to use [JuicyPixels](https://hackage.haskell.org/package/JuicyPixels)
6 | -- together with [halide-haskell](https://hackage.haskell.org/package/halide-haskell).
7 | -- It defines 'Language.Halide.IsHalideBuffer' instances for 'Image' and
8 | -- 'MutableImage' types from the JuicyPixels library.
9 | --
10 | -- That allows you to write code such as:
11 | --
12 | -- @
13 | -- kernel :: Ptr ('HalideBuffer' 3 Word8) -> Ptr ('HalideBuffer' 3 Word8) -> IO ()
14 | -- kernel = ...
15 | --
16 | -- brighten :: 'Image' 'PixelRGB8' -> 'MutableImage' 'RealWorld' 'PixelRGB8' -> IO ()
17 | -- brighten input output = do
18 | -- 'withHalideBuffer' @3 @Word8 input $ \input' ->
19 | -- 'withHalideBuffer' @3 @Word8 output $ \output' ->
20 | -- kernel input' output'
21 | -- @
22 | module Language.Halide.JuicyPixels ()
23 | where
24 |
25 | import Codec.Picture
26 | import Codec.Picture.Types
27 | import Control.Monad.ST (RealWorld)
28 | import Data.Vector.Storable qualified as S
29 | import Data.Vector.Storable.Mutable qualified as SM
30 | import Language.Halide
31 |
32 | instance (Pixel a, r ~ PixelBaseComponent a, IsHalideType r) => IsHalideBuffer (Image a) 3 r where
33 | withHalideBufferImpl :: Image a -> (Ptr (HalideBuffer 3 r) -> IO b) -> IO b
34 | withHalideBufferImpl im action =
35 | S.unsafeWith im.imageData $ \cpuPtr ->
36 | bufferFromPtrShape cpuPtr [componentCount (undefined :: a), im.imageWidth, im.imageHeight] action
37 |
38 | instance (Pixel a, r ~ PixelBaseComponent a, IsHalideType r) => IsHalideBuffer (MutableImage RealWorld a) 3 r where
39 | withHalideBufferImpl :: MutableImage RealWorld a -> (Ptr (HalideBuffer 3 r) -> IO b) -> IO b
40 | withHalideBufferImpl im action =
41 | SM.unsafeWith im.mutableImageData $ \cpuPtr ->
42 | bufferFromPtrShape
43 | cpuPtr
44 | [componentCount (undefined :: a), im.mutableImageWidth, im.mutableImageHeight]
45 | action
46 |
--------------------------------------------------------------------------------
/halide-JuicyPixels/test/Main.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE LambdaCase #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 | {-# LANGUAGE ViewPatterns #-}
4 |
5 | module Main (main) where
6 |
7 | import Codec.Picture
8 | import Codec.Picture.Types
9 | import Data.Word (Word8)
10 | import Language.Halide
11 | import Language.Halide.JuicyPixels
12 | import System.IO.Unsafe (unsafePerformIO)
13 | import Prelude hiding (min)
14 |
15 | brighten :: Expr Float -> Parameter 3 Word8 -> IO (Function 3 Word8)
16 | brighten factor input = do
17 | [x, y, c] <- mapM mkVar ["x", "y", "c"]
18 | let value = cast . min 255 . (factor *) . cast $ input ! (c, x, y)
19 | define "brighter" (c, x, y) value
20 |
21 | main :: IO ()
22 | main = do
23 | kernel <- compile brighten
24 |
25 | readImage "test/cat.jpg" >>= \case
26 | Right image -> do
27 | let rgb@(Image width height _) = convertRGB8 image
28 | output <- newMutableImage width height
29 |
30 | withHalideBuffer @3 @Word8 rgb $ \input ->
31 | withHalideBuffer @3 @Word8 output $ \output' ->
32 | kernel 2.5 input output'
33 |
34 | savePngImage "test.png" . ImageRGB8 =<< unsafeFreezeImage output
35 | Left e -> error e
36 |
--------------------------------------------------------------------------------
/halide-JuicyPixels/test/cat.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/twesterhout/halide-haskell/7e88a54bc5009ebcdd122c821aa74bd0fcfd5205/halide-JuicyPixels/test/cat.jpg
--------------------------------------------------------------------------------
/halide-arrayfire/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2023, twesterhout
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of twesterhout nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 |
--------------------------------------------------------------------------------
/halide-arrayfire/README.md:
--------------------------------------------------------------------------------
1 |
2 | halide-arrayfire
3 |
4 |
5 |
6 |
7 |
8 | [](LICENSE)
9 |
10 | [](https://github.com/twesterhout/halide-haskell/actions/workflows/ci.yml)
11 | [](https://hackage.haskell.org/package/halide-arrayfire)
12 |
13 |
14 |
15 | This package integrates
16 | [halide-haskell](https://github.com/twesterhout/halide-haskell/) with
17 | [arrayfire](https://github.com/arrayfire/arrayfire-haskell) by implementing
18 | an instance of `IsHalideBuffer` for the `Array` data type.
19 |
20 | - [X] CPU
21 | - [ ] CUDA (know how to do it, just need a bit of time)
22 | - [ ] OpenCL (no idea how, contributions are welcome!)
23 |
--------------------------------------------------------------------------------
/halide-arrayfire/halide-arrayfire.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-arrayfire
3 | version: 0.0.2.0
4 | synopsis: Integration between Halide and ArrayFire
5 | description:
6 | This package provides instances of [Language.Halide.IsHalideBuffer](https://hackage.haskell.org/package/halide-haskell/docs/Language-Halide.html#t:IsHalideBuffer)
7 | for arrays from the [arrayfire](https://hackage.haskell.org/package/arrayfire) library.
8 |
9 | homepage: https://github.com/twesterhout/halide-haskell
10 | license: BSD-3-Clause
11 | license-file: LICENSE
12 | author: Tom Westerhout
13 | maintainer:
14 | Tom Westerhout <14264576+twesterhout@users.noreply.github.com>
15 |
16 | category: Language
17 | copyright: 2022-2023 Tom Westerhout
18 | build-type: Simple
19 | extra-doc-files: README.md
20 | tested-with: GHC ==9.2.7 || ==9.4.4 || ==9.4.5
21 |
22 | common warnings
23 | ghc-options: -Wall
24 | default-language: GHC2021
25 |
26 | library
27 | import: warnings
28 | exposed-modules: Language.Halide.ArrayFire
29 | build-depends:
30 | , arrayfire >=0.7.0.0 && <0.8
31 | , base >=4.16.0.0 && <5
32 | , halide-haskell >=0.0.2.0 && <0.1
33 |
34 | ghc-options: -Wno-orphans
35 | hs-source-dirs: src
36 |
37 | test-suite halide-arrayfire-test
38 | import: warnings
39 | type: exitcode-stdio-1.0
40 | hs-source-dirs: test
41 | main-is: Spec.hs
42 | build-depends:
43 | , arrayfire
44 | , base
45 | , halide-arrayfire
46 | , halide-haskell
47 | , hspec >=2.9.7 && <3
48 |
--------------------------------------------------------------------------------
/halide-arrayfire/src/Language/Halide/ArrayFire.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DataKinds #-}
2 | {-# LANGUAGE TypeFamilies #-}
3 | {-# LANGUAGE UndecidableInstances #-}
4 |
5 | module Language.Halide.ArrayFire () where
6 |
7 | import ArrayFire (AFType, Array)
8 | import ArrayFire qualified as AF
9 | import Data.Proxy
10 | import GHC.TypeLits
11 | import Language.Halide
12 |
13 | forceNumDims :: AFType a => Array a -> Int -> [Int]
14 | forceNumDims arr n
15 | | AF.getNumDims arr <= n = take n shape
16 | | otherwise =
17 | error $
18 | "cannot treat a "
19 | <> show (AF.getNumDims arr)
20 | <> "-dimensional array as a "
21 | <> show n
22 | <> "-dimensional buffer"
23 | where
24 | shape = let (d0, d1, d2, d3) = AF.getDims arr in [d0, d1, d2, d3]
25 |
26 | instance (IsHalideType a, AFType a, KnownNat n, n <= 4) => IsHalideBuffer (Array a) n a where
27 | withHalideBufferImpl arr action = case AF.getBackend arr of
28 | AF.CPU -> AF.withDevicePtr arr $ \ptr -> bufferFromPtrShape ptr shape action
29 | AF.CUDA -> undefined
30 | AF.OpenCL -> undefined
31 | AF.Default -> error "do not know how to handle 'Default' backend"
32 | where
33 | shape = forceNumDims arr . fromIntegral $ natVal (Proxy @n)
34 |
--------------------------------------------------------------------------------
/halide-arrayfire/test/Spec.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DataKinds #-}
2 |
3 | module Main (main) where
4 |
5 | import ArrayFire qualified as AF
6 | import Language.Halide
7 | import Language.Halide.ArrayFire
8 | import Test.Hspec
9 |
10 | main :: IO ()
11 | main =
12 | hspec $
13 | describe "IsHalideBuffer" $ do
14 | it "supports CPU arrays" $ do
15 | let arr = 1 + AF.moddims (AF.range @Double [6] (-1)) [2, 3]
16 | -- print arr
17 | -- print =<< AF.getManualEvalFlag
18 | withHalideBuffer @2 @Double arr peekToList `shouldReturn` [[1, 3, 5], [2, 4, 6]]
19 |
--------------------------------------------------------------------------------
/halide-haskell.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-haskell
3 | version: 0.0.2.0
4 | synopsis: Haskell bindings to Halide
5 | description:
6 | Halide is a programming language designed to make it easier to write
7 | high-performance image and array processing code on modern machines. Rather
8 | than being a standalone programming language, Halide is embedded in C++. This
9 | means you write C++ code that builds an in-memory representation of a Halide
10 | pipeline using Halide's C++ API. You can then compile this representation to
11 | an object file, or JIT-compile it and run it in the same process.
12 | .
13 | This package provides Haskell bindings that allow to write Halide embedded in
14 | Haskell without C++.
15 | .
16 | The best way to learn Halide is to have a look at the
17 | [tutorials](https://github.com/twesterhout/halide-haskell/tree/master/tutorials).
18 | Reference documentation is provided by the haddocks of the 'Language.Halide'
19 | module.
20 |
21 | homepage: https://github.com/twesterhout/halide-haskell
22 | bug-reports: https://github.com/twesterhout/halide-haskell/issues
23 | license: BSD-3-Clause
24 | license-file: LICENSE
25 | author: Tom Westerhout
26 | maintainer:
27 | Tom Westerhout <14264576+twesterhout@users.noreply.github.com>
28 |
29 | category: Language
30 | copyright: 2022-2023 Tom Westerhout
31 | build-type: Simple
32 | extra-doc-files:
33 | construction.png
34 | README.md
35 |
36 | tested-with: GHC ==9.2.7 || ==9.4.4 || ==9.4.5
37 |
38 | source-repository head
39 | type: git
40 | location: https://github.com/twesterhout/halide-haskell.git
41 |
42 | common common-options
43 | build-depends: base >=4.16.0.0 && <5
44 | ghc-options:
45 | -W -Wall -Wcompat -Widentities -Wincomplete-uni-patterns
46 | -Wincomplete-record-updates -Wredundant-constraints
47 | -fhide-source-paths -Wmissing-export-lists -Wpartial-fields
48 | -Wmissing-deriving-strategies
49 |
50 | default-language: GHC2021
51 | default-extensions:
52 | DataKinds
53 | DerivingStrategies
54 | FunctionalDependencies
55 | LambdaCase
56 | OverloadedRecordDot
57 | OverloadedStrings
58 | TypeFamilies
59 | ViewPatterns
60 |
61 | library
62 | import: common-options
63 | hs-source-dirs: src
64 | exposed-modules: Language.Halide
65 | other-modules:
66 | Language.Halide.BoundaryConditions
67 | Language.Halide.Buffer
68 | Language.Halide.Context
69 | Language.Halide.Dimension
70 | Language.Halide.Expr
71 | Language.Halide.Func
72 | Language.Halide.Kernel
73 | Language.Halide.LoopLevel
74 | Language.Halide.RedundantConstraints
75 | Language.Halide.Schedule
76 | Language.Halide.Target
77 | Language.Halide.Trace
78 | Language.Halide.Type
79 | Language.Halide.Utils
80 |
81 | -- Language.Halide.Prelude
82 | build-depends:
83 | , bytestring >=0.11.1.0 && <0.12
84 | , constraints >=0.13.4 && <0.14
85 | , filepath >=1.4.2.1 && <2.0
86 | , inline-c >=0.9.1.6 && <0.10
87 | , inline-c-cpp >=0.5.0.0 && <0.6
88 | , primitive >=0.7.3.0 && <0.8
89 | , template-haskell >=2.18.0.0 && <3.0
90 | , temporary >=1.3 && <2.0
91 | , text >=1.2.5.0 && <3.0
92 | , vector >=0.12.3.0 && <0.13
93 |
94 | if os(windows)
95 | cpp-options: -DUSE_DLOPEN=0
96 | build-depends: Win32
97 |
98 | else
99 | cpp-options: -DUSE_DLOPEN=1
100 | build-depends: unix >=2.7.2.2 && <3.0
101 |
102 | extra-libraries: Halide
103 |
104 | -- if os(linux)
105 | -- extra-libraries: stdc++
106 |
107 | -- if os(osx)
108 | -- extra-libraries: iconv
109 |
110 | cxx-options: -std=c++17 -Wall
111 | ghc-options: -optcxx-std=c++17 -optcxx-Wall
112 |
113 | executable halide-haskell
114 | import: common-options
115 | hs-source-dirs: example
116 | main-is: Example01.hs
117 | build-depends:
118 | , halide-haskell
119 | , vector
120 |
121 | executable getting-started
122 | import: common-options
123 | hs-source-dirs: example
124 | main-is: GettingStarted.hs
125 | build-depends:
126 | , halide-haskell
127 | , vector
128 |
129 | executable halide-minimal-gpu
130 | import: common-options
131 | hs-source-dirs: example
132 | main-is: MinimalGPU.hs
133 | build-depends:
134 | , halide-haskell
135 | , vector
136 |
137 | test-suite halide-haskell-test
138 | import: common-options
139 | type: exitcode-stdio-1.0
140 | hs-source-dirs: test
141 | main-is: Spec.hs
142 | other-modules:
143 | Language.Halide.BoundaryConditionsSpec
144 | Language.Halide.BufferSpec
145 | Language.Halide.ExprSpec
146 | Language.Halide.FuncSpec
147 | Language.Halide.KernelSpec
148 | Language.Halide.LoopLevelSpec
149 | Language.Halide.ScheduleSpec
150 | Language.Halide.TargetSpec
151 | Utils
152 |
153 | build-depends:
154 | , halide-haskell
155 | , hspec >=2.9.7 && <3
156 | , HUnit >=1.6.2.0 && <1.7
157 | , inline-c
158 | , inline-c-cpp
159 | , QuickCheck >=2.14.2 && <3
160 | , text
161 | , vector
162 |
163 | cxx-options: -std=c++17 -Wall
164 | ghc-options:
165 | -threaded -rtsopts -with-rtsopts=-N -optcxx-std=c++17 -optcxx-Wall
166 | -Wno-missing-export-lists
167 |
168 | -- build-tools-depends: hspec-discover:hspec-discover
169 |
--------------------------------------------------------------------------------
/hie.yaml:
--------------------------------------------------------------------------------
1 | cradle:
2 | cabal:
3 | - path: "./src"
4 | component: "lib:halide-haskell"
5 |
6 | - path: "./example/Example01.hs"
7 | component: "halide-haskell:exe:halide-haskell"
8 |
9 | - path: "./example/GettingStarted.hs"
10 | component: "halide-haskell:exe:getting-started"
11 |
12 | - path: "./example/MinimalGPU.hs"
13 | component: "halide-haskell:exe:halide-minimal-gpu"
14 |
15 | - path: "./test"
16 | component: "halide-haskell:test:halide-haskell-test"
17 |
18 | - path: "halide-JuicyPixels/src"
19 | component: "lib:halide-JuicyPixels"
20 |
21 | - path: "halide-JuicyPixels/test"
22 | component: "halide-JuicyPixels:test:halide-JuicyPixels-test"
23 |
24 | - path: "halide-arrayfire/src"
25 | component: "lib:halide-arrayfire"
26 |
27 | - path: "halide-arrayfire/test"
28 | component: "halide-arrayfire:test:halide-arrayfire-test"
29 |
30 | - path: "test-readme/./README.lhs"
31 | component: "halide-readme:exe:halide-readme"
32 |
33 | - path: "test-readme/./"
34 | component: "halide-readme:test:halide-readme-test"
35 |
36 | - path: "tutorials/01-Basics/./README.lhs"
37 | component: "halide-tutorial01:exe:halide-tutorial01"
38 |
39 | - path: "tutorials/01-Basics/./"
40 | component: "halide-tutorial01:test:halide-tutorial01-test"
41 |
42 | - path: "tutorials/03-Inspecting/./README.lhs"
43 | component: "halide-tutorial03:exe:halide-tutorial03"
44 |
45 | - path: "tutorials/03-Inspecting/./"
46 | component: "halide-tutorial03:test:halide-tutorial03-test"
47 |
48 | - path: "tutorials/04-Debugging/./README.lhs"
49 | component: "halide-tutorial04:exe:halide-tutorial04"
50 |
51 | - path: "tutorials/04-Debugging/./"
52 | component: "halide-tutorial04:test:halide-tutorial04-test"
53 |
54 | - path: "tutorials/05-Scheduling/./README.lhs"
55 | component: "halide-tutorial05:exe:halide-tutorial05"
56 |
57 | - path: "tutorials/05-Scheduling/./"
58 | component: "halide-tutorial05:test:halide-tutorial05-test"
59 |
--------------------------------------------------------------------------------
/nix/arrayfire-no-download.patch:
--------------------------------------------------------------------------------
1 | diff --git a/CMakeLists.txt b/CMakeLists.txt
2 | index e795f2a79..530341f0e 100644
3 | --- a/CMakeLists.txt
4 | +++ b/CMakeLists.txt
5 | @@ -272,11 +272,12 @@ else()
6 | endif()
7 |
8 | if(NOT TARGET glad::glad)
9 | - af_dep_check_and_populate(${glad_prefix}
10 | - URI https://github.com/arrayfire/glad.git
11 | - REF main
12 | - )
13 | - add_subdirectory(${${glad_prefix}_SOURCE_DIR} ${${glad_prefix}_BINARY_DIR})
14 | + # af_dep_check_and_populate(${glad_prefix}
15 | + # URI https://github.com/arrayfire/glad.git
16 | + # REF main
17 | + # )
18 | + set(${glad_prefix}_SOURCE_DIR ${AF_GLAD_PATH})
19 | + add_subdirectory(${${glad_prefix}_SOURCE_DIR})
20 |
21 | add_library(af_glad STATIC $)
22 | target_link_libraries(af_glad PUBLIC ${CMAKE_DL_LIBS})
23 | @@ -301,10 +302,11 @@ if(NOT TARGET nonstd::span-lite)
24 |
25 | endif()
26 |
27 | -af_dep_check_and_populate(${assets_prefix}
28 | - URI https://github.com/arrayfire/assets.git
29 | - REF master
30 | -)
31 | +# af_dep_check_and_populate(${assets_prefix}
32 | +# URI https://github.com/arrayfire/assets.git
33 | +# REF master
34 | +# )
35 | +set(${assets_prefix}_SOURCE_DIR ${AF_ASSETS_PATH})
36 | set(ASSETS_DIR ${${assets_prefix}_SOURCE_DIR})
37 |
38 | # when crosscompiling use the bin2cpp file from the native bin directory
39 | diff --git a/CMakeModules/build_CLBlast.cmake b/CMakeModules/build_CLBlast.cmake
40 | index 402e2b6f4..641158b20 100644
41 | --- a/CMakeModules/build_CLBlast.cmake
42 | +++ b/CMakeModules/build_CLBlast.cmake
43 | @@ -24,10 +24,12 @@ if(TARGET clblast OR AF_WITH_EXTERNAL_PACKAGES_ONLY)
44 | message(ERROR "CLBlast now found")
45 | endif()
46 | else()
47 | - af_dep_check_and_populate(${clblast_prefix}
48 | - URI https://github.com/cnugteren/CLBlast.git
49 | - REF 4500a03440e2cc54998c0edab366babf5e504d67
50 | - )
51 | + # af_dep_check_and_populate(${clblast_prefix}
52 | + # URI https://github.com/cnugteren/CLBlast.git
53 | + # REF 4500a03440e2cc54998c0edab366babf5e504d67
54 | + # )
55 | + set(${clblast_prefix}_SOURCE_DIR ${AF_CLBLAST_PATH})
56 | + set(${clblast_prefix}_BINARY_DIR ${CMAKE_BINARY_DIR}/clblast)
57 |
58 | include(ExternalProject)
59 | find_program(GIT git)
60 | diff --git a/CMakeModules/build_clFFT.cmake b/CMakeModules/build_clFFT.cmake
61 | index b3e56137b..e2e8b1b0d 100644
62 | --- a/CMakeModules/build_clFFT.cmake
63 | +++ b/CMakeModules/build_clFFT.cmake
64 | @@ -5,10 +5,11 @@
65 | # The complete license agreement can be obtained at:
66 | # http://arrayfire.com/licenses/BSD-3-Clause
67 |
68 | -af_dep_check_and_populate(${clfft_prefix}
69 | - URI https://github.com/arrayfire/clFFT.git
70 | - REF arrayfire-release
71 | -)
72 | +# af_dep_check_and_populate(${clfft_prefix}
73 | +# URI https://github.com/arrayfire/clFFT.git
74 | +# REF arrayfire-release
75 | +# )
76 | +set(${clfft_prefix}_SOURCE_DIR ${CMAKE_CURRENT_SOURCE_DIR}/extern/clfft)
77 |
78 | set(current_build_type ${BUILD_SHARED_LIBS})
79 | set(BUILD_SHARED_LIBS OFF)
80 | diff --git a/src/backend/cpu/CMakeLists.txt b/src/backend/cpu/CMakeLists.txt
81 | index d0137ed90..115c22bfe 100644
82 | --- a/src/backend/cpu/CMakeLists.txt
83 | +++ b/src/backend/cpu/CMakeLists.txt
84 | @@ -272,10 +272,11 @@ if (AF_WITH_CPUID)
85 | target_compile_definitions(afcpu PRIVATE -DAF_WITH_CPUID)
86 | endif(AF_WITH_CPUID)
87 |
88 | -af_dep_check_and_populate(${threads_prefix}
89 | - URI https://github.com/arrayfire/threads.git
90 | - REF b666773940269179f19ef11c8f1eb77005e85d9a
91 | -)
92 | +# af_dep_check_and_populate(${threads_prefix}
93 | +# URI https://github.com/arrayfire/threads.git
94 | +# REF b666773940269179f19ef11c8f1eb77005e85d9a
95 | +# )
96 | +set(${threads_prefix}_SOURCE_DIR ${AF_THREADS_PATH})
97 |
98 | target_sources(afcpu
99 | PRIVATE
100 |
--------------------------------------------------------------------------------
/nix/arrayfire.nix:
--------------------------------------------------------------------------------
1 | { boost
2 | , cmake
3 | , fetchFromGitHub
4 | , forge
5 | , freeimage
6 | , fftw
7 | , fftwFloat
8 | , gtest
9 | , lib
10 | , libGLU
11 | , libGL
12 | , mesa
13 | , ocl-icd
14 | , openblas
15 | , opencl-clhpp
16 | , pkg-config
17 | , python3
18 | , span-lite
19 | , spdlog
20 | , stdenv
21 | }:
22 |
23 | stdenv.mkDerivation rec {
24 | pname = "arrayfire";
25 | version = "3.8.3";
26 | src = fetchFromGitHub {
27 | owner = pname;
28 | repo = pname;
29 | rev = "v${version}";
30 | sha256 = "sha256-Chk7koBv66JsfKV6+y6wg21snXYZswo6hjYm8rYEbbs=";
31 | };
32 |
33 | assets = fetchFromGitHub {
34 | owner = pname;
35 | repo = "assets";
36 | rev = "cd08d749611b324012555ad6f23fd76c5465bd6c";
37 | sha256 = "sha256-v4uhqPz1P1g1430FTmMp22xJS50bb5hZTeEX49GgMWg=";
38 | };
39 | clblast = fetchFromGitHub {
40 | owner = "cnugteren";
41 | repo = "CLBlast";
42 | rev = "4500a03440e2cc54998c0edab366babf5e504d67";
43 | sha256 = "sha256-I25ylQp6kHZx6Q7Ph5r3abWlQ6yeIHIDdS1eGCyArZ0=";
44 | };
45 | clfft = fetchFromGitHub {
46 | owner = pname;
47 | repo = "clfft";
48 | rev = "arrayfire-release";
49 | sha256 = "sha256-vJo1YfC2AJIbbRj/zTfcOUmi0Oj9v64NfA9MfK8ecoY=";
50 | };
51 | glad = fetchFromGitHub {
52 | owner = pname;
53 | repo = "glad";
54 | rev = "ef8c5508e72456b714820c98e034d9a55b970650";
55 | sha256 = "sha256-u9Vec7XLhE3xW9vzM7uuf+b18wZsh/VMtGbB6nMVlno=";
56 | };
57 | threads = fetchFromGitHub {
58 | owner = pname;
59 | repo = "threads";
60 | rev = "4d4a4f0384d1ac2f25b2c4fc1d57b9e25f4d6818";
61 | sha256 = "sha256-qqsT9woJDtQvzuV323OYXm68pExygYs/+zZNmg2sN34=";
62 | };
63 | test-data = fetchFromGitHub {
64 | owner = pname;
65 | repo = "arrayfire-data";
66 | rev = "a5f533d7b864a4d8f0dd7c9aaad5ff06018c4867";
67 | sha256 = "sha256-AWzhsrDXyZrQN2bd0Ng/XlE8v02x7QWTiFTyaAuRXSw=";
68 | };
69 |
70 | cmakeFlags = [
71 | "-DBUILD_TESTING=ON"
72 | "-DAF_BUILD_EXAMPLES=ON"
73 | "-DAF_BUILD_FORGE=OFF"
74 | "-DAF_BUILD_OPENCL=OFF"
75 | "-DAF_USE_RELATIVE_TEST_DIR=ON"
76 |
77 | "-DAF_ASSETS_PATH=extern/assets"
78 | "-DAF_GLAD_PATH=extern/glad"
79 | "-DAF_THREADS_PATH=extern/threads"
80 | ];
81 | # ++ (lib.optional stdenv.isDarwin "-DAF_BUILD_OPENCL=OFF");
82 |
83 | patches = [ ./arrayfire-no-download.patch ];
84 | postPatch = ''
85 | cp -R --no-preserve=mode,ownership ${assets} ./extern/assets
86 | cp -R --no-preserve=mode,ownership ${glad} ./extern/glad
87 |
88 | mkdir -p ./src/backend/cpu/extern
89 | cp -R --no-preserve=mode,ownership ${threads} ./src/backend/cpu/extern/threads
90 |
91 | cp -R --no-preserve=mode,ownership ${test-data} ./test/data
92 |
93 | substituteInPlace src/api/unified/symbol_manager.cpp \
94 | --replace '"/opt/arrayfire-3/lib/",' \
95 | "\"$out/lib/\", \"/opt/arrayfire-3/lib/\","
96 | '';
97 | # + lib.optionalString stdenv.isLinux ''
98 | # mkdir -p ./build/include/CL
99 | # cp -R --no-preserve=mode,ownership ${opencl-clhpp}/include/CL/cl2.hpp ./build/include/CL/cl2.hpp
100 |
101 | # mkdir -p ./build/third_party/CLBlast/src
102 | # cp -R --no-preserve=mode,ownership ${clblast} ./build/third_party/CLBlast/src/CLBlast-ext
103 |
104 | # mkdir -p ./src/backend/opencl/extern
105 | # cp -R --no-preserve=mode,ownership ${clfft} ./src/backend/opencl/extern/clfft
106 | # '';
107 |
108 | # Some tests currently fail, see https://github.com/arrayfire/arrayfire/issues/3384
109 | doCheck = false;
110 | checkPhase = ''
111 | export LD_LIBRARY_PATH="${forge}/lib:${freeimage}/lib:$LD_LIBRARY_PATH"
112 | AF_TRACE=all AF_PRINT_ERRORS=1 ctest -v -j1
113 | '';
114 |
115 | buildInputs = [
116 | forge
117 | boost.out
118 | boost.dev
119 | fftw
120 | fftwFloat
121 | freeimage
122 | gtest
123 | libGL
124 | mesa
125 | (openblas.override { blas64 = false; })
126 | span-lite
127 | spdlog
128 | ];
129 | # ++ (lib.optionals stdenv.isLinux [ libGLU libGL mesa ocl-icd opencl-clhpp ]);
130 |
131 | nativeBuildInputs = [
132 | cmake
133 | pkg-config
134 | python3
135 | ];
136 |
137 | meta = with lib; {
138 | description = "A general-purpose library for parallel and massively-parallel computations";
139 | longDescription = ''
140 | A general-purpose library that simplifies the process of developing software that targets parallel and massively-parallel architectures including CPUs, GPUs, and other hardware acceleration devices.";
141 | '';
142 | license = licenses.bsd3;
143 | homepage = "https://arrayfire.com/";
144 | platforms = platforms.linux ++ platforms.darwin;
145 | maintainers = with maintainers; [ chessai ];
146 | };
147 | }
148 |
--------------------------------------------------------------------------------
/nix/forge-no-download.patch:
--------------------------------------------------------------------------------
1 | diff --git a/CMakeLists.txt b/CMakeLists.txt
2 | index de1a80e..2ea09fe 100644
3 | --- a/CMakeLists.txt
4 | +++ b/CMakeLists.txt
5 | @@ -68,17 +68,19 @@ if(Boost_FOUND AND NOT TARGET Boost::boost)
6 | endif(Boost_FOUND AND NOT TARGET Boost::boost)
7 |
8 | if(NOT TARGET glad::glad) # find_package(glad) failed
9 | - fg_dep_check_and_populate(${glad_prefix}
10 | - URI https://github.com/arrayfire/glad.git
11 | - REF obj_lib
12 | - )
13 | - add_subdirectory(${${glad_prefix}_SOURCE_DIR} ${${glad_prefix}_BINARY_DIR})
14 | -
15 | - add_library(forge_glad STATIC $)
16 | + # fg_dep_check_and_populate(${glad_prefix}
17 | + # URI https://github.com/arrayfire/glad.git
18 | + # REF obj_lib
19 | + # )
20 | + # add_subdirectory(${${glad_prefix}_SOURCE_DIR} ${${glad_prefix}_BINARY_DIR})
21 | + set(${glad_prefix}_SOURCE_DIR ${AF_GLAD_PATH})
22 | + add_subdirectory(${${glad_prefix}_SOURCE_DIR})
23 | +
24 | + add_library(forge_glad STATIC $)
25 | target_link_libraries(forge_glad PUBLIC ${CMAKE_DL_LIBS})
26 | target_include_directories(forge_glad
27 | PUBLIC
28 | - $>
29 | + $>
30 | )
31 | else()
32 | add_library(forge_glad ALIAS glad::glad)
33 |
--------------------------------------------------------------------------------
/nix/forge.nix:
--------------------------------------------------------------------------------
1 | { lib
2 | , stdenv
3 | , fetchFromGitHub
4 | , cmake
5 | , pkg-config
6 | , expat
7 | , fontconfig
8 | , freeimage
9 | , freetype
10 | , boost
11 | , mesa
12 | , libGLU
13 | , libGL
14 | , glfw3
15 | , glm
16 | , SDL2
17 | }:
18 |
19 | stdenv.mkDerivation rec {
20 | pname = "forge";
21 | version = "1.0.8";
22 |
23 | src = fetchFromGitHub {
24 | owner = "arrayfire";
25 | repo = pname;
26 | rev = "v1.0.8";
27 | sha256 = "sha256-lSZAwcqAHiuZkpYcVfwvZCfNmEF3xGN9S/HuZQrGeKU=";
28 | };
29 | glad = fetchFromGitHub {
30 | owner = "arrayfire";
31 | repo = "glad";
32 | rev = "ef8c5508e72456b714820c98e034d9a55b970650";
33 | sha256 = "sha256-u9Vec7XLhE3xW9vzM7uuf+b18wZsh/VMtGbB6nMVlno=";
34 | };
35 |
36 | patches = [ ./forge-no-download.patch ];
37 | postPatch = ''
38 | mkdir -p ./extern
39 | cp -R --no-preserve=mode,ownership ${glad} ./extern/glad
40 | '';
41 |
42 | cmakeFlags = [ "-DAF_GLAD_PATH=extern/glad" ];
43 |
44 | doCheck = true;
45 |
46 | nativeBuildInputs = [
47 | cmake
48 | pkg-config
49 | ];
50 |
51 | buildInputs = [
52 | expat
53 | fontconfig
54 | freetype
55 | boost.out
56 | boost.dev
57 | freeimage
58 | mesa
59 | libGLU
60 | libGL
61 | glfw3
62 | glm
63 | SDL2
64 | ];
65 |
66 | meta = with lib; {
67 | description = "An OpenGL interop library that can be used with ArrayFire or any other application using CUDA or OpenCL compute backend";
68 | longDescription = ''
69 | An OpenGL interop library that can be used with ArrayFire or any other application using CUDA or OpenCL compute backend.
70 | The goal of Forge is to provide high performance OpenGL visualizations for C/C++ applications that use CUDA/OpenCL.
71 | Forge uses OpenGL >=3.3 forward compatible contexts, so please make sure you have capable hardware before trying it out.
72 | '';
73 | license = licenses.bsd3;
74 | homepage = "https://arrayfire.com/";
75 | platforms = platforms.linux ++ platforms.darwin;
76 | maintainers = with maintainers; [ chessai ];
77 | };
78 | }
79 |
--------------------------------------------------------------------------------
/nix/halide.nix:
--------------------------------------------------------------------------------
1 | { stdenv
2 | , llvmPackages_14
3 | , lib
4 | , fetchFromGitHub
5 | , cmake
6 | , libpng
7 | , libjpeg
8 | , mesa
9 | , eigen
10 | , openblas
11 | , blas
12 | , lapack
13 | }:
14 |
15 | assert blas.implementation == "openblas" && lapack.implementation == "openblas";
16 |
17 | stdenv.mkDerivation rec {
18 | pname = "halide";
19 | version = "15.0.0";
20 |
21 | src = fetchFromGitHub {
22 | owner = "halide";
23 | repo = "Halide";
24 | rev = "v${version}";
25 | sha256 = "sha256-te9Yn/rmA0YSulnxXL/y5d8PFphjQPgZUDWHNn7oqMg=";
26 | };
27 |
28 | cmakeFlags = [ "-DWARNINGS_AS_ERRORS=OFF" "-DWITH_PYTHON_BINDINGS=OFF" "-DTARGET_WEBASSEMBLY=OFF" ];
29 |
30 | doCheck = true;
31 |
32 | # Note: only openblas and not atlas part of this Nix expression
33 | # see pkgs/development/libraries/science/math/liblapack/3.5.0.nix
34 | # to get a hint howto setup atlas instead of openblas
35 | buildInputs = [
36 | llvmPackages_14.llvm
37 | llvmPackages_14.lld
38 | llvmPackages_14.openmp
39 | llvmPackages_14.libclang
40 | libpng
41 | libjpeg
42 | eigen
43 | openblas
44 | ]
45 | ++ lib.optional stdenv.isLinux mesa;
46 |
47 | nativeBuildInputs = [ cmake ];
48 |
49 | meta = with lib; {
50 | description = "C++ based language for image processing and computational photography";
51 | homepage = "https://halide-lang.org";
52 | license = licenses.mit;
53 | platforms = platforms.all;
54 | maintainers = with maintainers; [ ck3d atila ];
55 | };
56 | }
57 |
--------------------------------------------------------------------------------
/print_loop_nest.patch:
--------------------------------------------------------------------------------
1 | diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
2 | index 4f4b8e532..ae93b8894 100644
3 | --- a/src/CMakeLists.txt
4 | +++ b/src/CMakeLists.txt
5 | @@ -69,7 +69,7 @@ set(HEADER_FILES
6 | FindIntrinsics.h
7 | FlattenNestedRamps.h
8 | Float16.h
9 | - Func.h
10 | + Func.h PrintLoopNest.h
11 | Function.h
12 | FunctionPtr.h
13 | FuseGPUThreadLoops.h
14 |
--------------------------------------------------------------------------------
/shell.nix:
--------------------------------------------------------------------------------
1 | # This file is taken from https://github.com/edolstra/flake-compat
2 | # It probably never needs to change.
3 |
4 | let
5 | lock = builtins.fromJSON (builtins.readFile ./flake.lock);
6 | flake-compat = fetchTarball {
7 | url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz";
8 | sha256 = lock.nodes.flake-compat.locked.narHash;
9 | };
10 | in
11 | (import flake-compat { src = ./.; }).shellNix
12 |
--------------------------------------------------------------------------------
/src/Language/Halide.hs:
--------------------------------------------------------------------------------
1 | -- |
2 | -- Module : Language.Halide
3 | -- Copyright : (c) Tom Westerhout, 2023
4 | --
5 | -- This package provides Haskell bindings that allow to write Halide embedded in Haskell without C++.
6 | --
7 | -- This module contains the reference documentation for Halide. If you're new, the best way to learn Halide is to have a look at the [tutorials](https://github.com/twesterhout/halide-haskell/tree/master/tutorials).
8 | module Language.Halide
9 | ( -- * Scalar expressions
10 |
11 | -- | The basic building block of Halide pipelines is 'Expr'. @Expr a@ represents a scalar expression of
12 | -- type @a@, where @a@ must be an instance of 'IsHalideType'.
13 | Expr (..)
14 | , Var
15 | , RVar
16 | , VarOrRVar
17 | , IsHalideType
18 | , ReductionDomain
19 |
20 | -- ** Creating
21 | , mkExpr
22 | , mkVar
23 | , mkRVar
24 | , mkRDom
25 | , toRVars
26 | , undef
27 | , cast
28 | , ifThenElse
29 |
30 | -- ** Inspecting
31 | , toIntImm
32 | , printed
33 | , printedWhen
34 | , evaluate
35 |
36 | -- ** Comparisons
37 |
38 | -- | We can't use 'Eq' and 'Ord' instances here, because we want the comparison to happen
39 | -- when the pipeline is run rather than when it's built. Hence, we define lifted version of
40 | -- various comparison operators. Note, that infix versions of the these functions have the
41 | -- same precedence as the normal comparison operators.
42 | , eq
43 | , neq
44 | , lt
45 | , lte
46 | , gt
47 | , gte
48 | , min
49 | , max
50 | , div
51 | , mod
52 |
53 | -- ** Boolean functions
54 | , and
55 | , or
56 |
57 | -- * Functions
58 | , Func (..)
59 | , Function
60 | , Parameter
61 | , FuncTy (..)
62 | , Stage (..)
63 |
64 | -- ** Creating
65 | , define
66 | , update
67 | , (!)
68 | , repeatEdge
69 | , constantExterior
70 |
71 | -- ** Inspecting
72 | , getArgs
73 | , hasUpdateDefinitions
74 | , getUpdateStage
75 |
76 | -- * Buffers
77 |
78 | -- | In the C interface of Halide, buffers are described by the C struct
79 | -- [@halide_buffer_t@](https://halide-lang.org/docs/structhalide__buffer__t.html). On the Haskell side,
80 | -- we have 'HalideBuffer'.
81 | , HalideBuffer (..)
82 | -- | To easily test out your pipeline, there are helper functions to create 'HalideBuffer's without
83 | -- worrying about the low-level representation.
84 | , allocaCpuBuffer
85 | , allocaBuffer
86 | -- | Buffers can also be converted to lists to easily print them for debugging.
87 | , IsListPeek (..)
88 | , peekScalar
89 | -- | For production usage however, you don't want to work with lists. Instead, you probably want Halide
90 | -- to work with your existing array data types. For this, we define 'IsHalideBuffer' typeclass that
91 | -- teaches Halide how to convert your data into a 'HalideBuffer'. Depending on how you implement the
92 | -- instance, this can be very efficient, because it need not involve any memory copying.
93 | , IsHalideBuffer (..)
94 | , withHalideBuffer
95 | -- | There are also helper functions to simplify writing instances of 'IsHalideBuffer'.
96 | , bufferFromPtrShapeStrides
97 | , bufferFromPtrShape
98 |
99 | -- * Running the pipelines
100 |
101 | -- | There are a few ways how one can run a Halide pipeline.
102 | --
103 | -- The simplest way to build a t'Func' and then call 'realize' to evaluate it over a rectangular domain.
104 | , realize
105 | , realizeOnTarget
106 | , asBufferParam
107 | -- | The drawback of calling 'realize' all the time is that it's impossible to pass parameters to pipelines.
108 | -- We can define pipelines that operate on buffers using 'asBufferParam', but we have to recompile the
109 | -- pipeline for every new buffer.
110 | --
111 | -- A better way to handle pipeline parameters is to define a /Haskell/ function that accepts t'Expr's
112 | -- and t'Func's as arguments and returns a 'Func'. We can then pass this function to 'compile'
113 | -- (or 'compileForTarget'), and it compile it into a /Haskell/ function that can now be invoked with
114 | -- normal scalars instead of t'Expr's and @Ptr 'HalideBuffer'@s instead of 'Func's.
115 | , compile
116 |
117 | -- ** Parameters
118 |
119 | -- | Similar to how we can specify the name of a variable in 'mkVar' (or 'mkRVar') or function in 'define',
120 | -- one can also specify the name of a pipeline parameter. This is achieved by using the @ViewPatterns@
121 | -- extension together with the 'scalar' and 'buffer' helper functions.
122 | , buffer
123 | , scalar
124 | -- | Another common thing to do with the parameters is to explicitly specify their shapes. For this, we expose the 'Dimension' type:
125 | , Dimension (..)
126 | , dim
127 | , setMin
128 | , setExtent
129 | , setStride
130 | , setEstimate
131 | , setScalarEstimate
132 |
133 | -- ** Targets
134 | , Target (..)
135 | , hostTarget
136 | , gpuTarget
137 | , compileForTarget
138 | , DeviceAPI (..)
139 | , TargetFeature (..)
140 | , setFeature
141 | , hasGpuFeature
142 | , hostSupportsTargetDevice
143 |
144 | -- * Scheduling
145 | , Schedulable (..)
146 | , TailStrategy (..)
147 | , LoopLevel (..)
148 | , LoopLevelTy (..)
149 | , LoopAlignStrategy (..)
150 | , computeRoot
151 | , getStage
152 | , getLoopLevel
153 | , getLoopLevelAtStage
154 | , asUsed
155 | , asUsedBy
156 | , copyToDevice
157 | , copyToHost
158 | , storeAt
159 | , computeAt
160 | , estimate
161 | , bound
162 |
163 | -- * Debugging / Tracing
164 |
165 | -- | For debugging, it's often useful to observe the value of an expression when it's evaluated. If you
166 | -- have a complex expression that does not depend on any buffers or indices, you can 'evaluate' it.
167 | -- | However, often an expression is only used within a definition of a pipeline, and it's impossible to
168 | -- call 'evaluate' on it. In such cases, it can be wrapped with 'printed' to indicate to Halide that the
169 | -- value of the expression should be dumped to screen when it's computed.
170 | , prettyLoopNest
171 | , compileToLoweredStmt
172 | , StmtOutputFormat (..)
173 | , TraceEvent (..)
174 | , TraceEventCode (..)
175 | , TraceLoadStoreContents (..)
176 | , setCustomTrace
177 | , traceStores
178 | , traceLoads
179 | , collectIterationOrder
180 |
181 | -- * Type helpers
182 | , IsTuple (..)
183 | , ToTuple
184 | , FromTuple
185 | , Length
186 | , All
187 |
188 | -- * Internal
189 | , compileToCallable
190 | , testCUDA
191 | , testOpenCL
192 | , SomeLoopLevel (..)
193 | , RawHalideBuffer (..)
194 | , HalideDimension (..)
195 | , HalideDeviceInterface
196 | , rowMajorStrides
197 | , colMajorStrides
198 | , isDeviceDirty
199 | , isHostDirty
200 | , getBufferExtent
201 | , bufferCopyToHost
202 | , withCopiedToHost
203 | , withCropped
204 | , module Language.Halide.Schedule
205 | , FunctionArguments
206 | , FunctionReturn
207 | , Curry (..)
208 | , UnCurry (..)
209 | , LoweredSignature
210 |
211 | -- ** inline-c helpers
212 | , importHalide
213 | , testWriteToStderr
214 | , CxxExpr
215 | , CxxVar
216 | , CxxRVar
217 | , CxxParameter
218 | , CxxFunc
219 | , CxxImageParam
220 | , CxxStage
221 | , CxxDimension
222 | , CxxTarget
223 | , CxxLoopLevel
224 |
225 | -- * Convenience re-exports
226 | , Int32
227 | , Ptr
228 | , KnownNat
229 | )
230 | where
231 |
232 | import Foreign.Ptr (Ptr)
233 | import GHC.TypeLits (KnownNat)
234 | import Language.Halide.BoundaryConditions
235 | import Language.Halide.Buffer
236 | import Language.Halide.Context
237 | import Language.Halide.Dimension
238 | import Language.Halide.Expr
239 | import Language.Halide.Func
240 | import Language.Halide.Kernel
241 | import Language.Halide.LoopLevel
242 | import Language.Halide.Schedule
243 | import Language.Halide.Target
244 | import Language.Halide.Trace
245 | import Language.Halide.Type
246 | import Prelude ()
247 |
--------------------------------------------------------------------------------
/src/Language/Halide/BoundaryConditions.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE QuasiQuotes #-}
2 | {-# LANGUAGE TemplateHaskell #-}
3 |
4 | -- |
5 | -- Module : Language.Halide.BoundaryConditions
6 | -- Copyright : (c) Tom Westerhout, 2023
7 | module Language.Halide.BoundaryConditions
8 | ( repeatEdge
9 | , constantExterior
10 | )
11 | where
12 |
13 | import GHC.TypeLits
14 | import Language.C.Inline.Unsafe qualified as CU
15 | import Language.Halide.Buffer
16 | import Language.Halide.Context
17 | import Language.Halide.Expr
18 | import Language.Halide.Func
19 | import Language.Halide.Type
20 | import Prelude hiding (min, tail)
21 |
22 | importHalide
23 |
24 | -- | Impose a boundary condition such that the nearest edge sample is returned everywhere outside the given region.
25 | --
26 | -- For more information, see [@Halide::repeat_edge@](https://halide-lang.org/docs/namespace_halide_1_1_boundary_conditions.html#a0548f23db36e4a8a03690bc8bee1e850).
27 | repeatEdge :: (KnownNat n, IsHalideType a) => Func 'ParamTy n (Expr a) -> IO (Func 'FuncTy n (Expr a))
28 | repeatEdge source =
29 | withBufferParam source $ \source' ->
30 | wrapCxxFunc
31 | =<< [CU.exp| Halide::Func* { new Halide::Func{
32 | Halide::BoundaryConditions::repeat_edge(*$(const Halide::ImageParam* source'))} } |]
33 |
34 | -- | Impose a boundary condition such that a given expression is returned everywhere outside the boundary.
35 | --
36 | -- For more information, see [@Halide::constant_exterior@](https://halide-lang.org/docs/namespace_halide_1_1_boundary_conditions.html#aa4ed713b5f9a6f13e6323f2a21d41d5e).
37 | constantExterior :: (KnownNat n, IsHalideType a) => Expr a -> Func 'ParamTy n (Expr a) -> IO (Func 'FuncTy n (Expr a))
38 | constantExterior value source =
39 | withBufferParam source $ \source' ->
40 | asExpr value $ \value' ->
41 | wrapCxxFunc
42 | =<< [CU.exp| Halide::Func* { new Halide::Func{
43 | Halide::BoundaryConditions::constant_exterior(
44 | *$(const Halide::ImageParam* source'), *$(const Halide::Expr* value'))} } |]
45 |
--------------------------------------------------------------------------------
/src/Language/Halide/Context.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskellQuotes #-}
2 |
3 | -- |
4 | -- Module : Language.Halide.Context
5 | -- Description : Helpers to setup inline-c for Halide
6 | -- Copyright : (c) Tom Westerhout, 2023
7 | --
8 | -- This module defines a Template Haskell function 'importHalide' that sets up everything you need
9 | -- to call Halide functions from 'Language.C.Inline' and 'Language.C.Inlinde.Cpp' quasiquotes.
10 | --
11 | -- We also define two C++ functions:
12 | --
13 | -- > template
14 | -- > auto handle_halide_exceptions(Func&& func);
15 | -- >
16 | -- > template
17 | -- > auto to_string_via_iostream(T const& x) -> std::string*;
18 | --
19 | -- @handle_halide_exceptions@ can be used to catch various Halide exceptions and convert them to
20 | -- [@std::runtime_error@](https://en.cppreference.com/w/cpp/error/runtime_error). It can be used
21 | -- inside 'C.tryBlock' or 'C.catchBlock' to properly re-throw Halide errors.
22 | --
23 | -- @
24 | -- [C.catchBlock| void {
25 | -- handle_halide_exceptions([=]() {
26 | -- Halide::Func f;
27 | -- Halide::Var i;
28 | -- f(i) = *$(Halide::Expr* e);
29 | -- f.realize(Halide::Pipeline::RealizationArg{$(halide_buffer_t* b)});
30 | -- });
31 | -- } |]
32 | -- @
33 | --
34 | -- @to_string_via_iostream@ is a helper that converts a variable into a string by relying on
35 | -- [iostreams](https://en.cppreference.com/w/cpp/io). It returns a pointer to
36 | -- [@std::string@](https://en.cppreference.com/w/cpp/string/basic_string) that it allocated using the @new@
37 | -- keyword. To convert it to a Haskell string, use the 'Language.Halide.Utils.peekCxxString' and
38 | -- 'Language.Halide.Utils.peekAndDeleteCxxString' functions.
39 | module Language.Halide.Context
40 | ( importHalide
41 | )
42 | where
43 |
44 | import Language.C.Inline qualified as C
45 | import Language.C.Inline.Cpp qualified as C
46 | import Language.C.Types (CIdentifier)
47 | import Language.Halide.Type
48 | import Language.Haskell.TH (DecsQ, Q, TypeQ, lookupTypeName)
49 | import Language.Haskell.TH qualified as TH
50 |
51 | -- | One stop function to include all the neccessary machinery to call Halide functions via inline-c.
52 | --
53 | -- Put @importHalide@ somewhere at the beginning of the file and enjoy using the C++ interface of
54 | -- Halide via inline-c quasiquotes.
55 | importHalide :: DecsQ
56 | importHalide =
57 | concat
58 | <$> sequence
59 | [ C.context =<< halideCxt
60 | , C.include ""
61 | , -- , C.include ""
62 | -- , C.include ""
63 | C.include ""
64 | , C.include ""
65 | , defineExceptionHandler
66 | ]
67 |
68 | halideCxt :: Q C.Context
69 | halideCxt = do
70 | typePairs <- C.cppTypePairs <$> halideTypePairs
71 | pure (C.cppCtx <> C.fptrCtx <> C.bsCtx <> typePairs)
72 |
73 | halideTypePairs :: Q [(CIdentifier, TypeQ)]
74 | halideTypePairs = do
75 | fmap concat . sequence $ [core, other]
76 | where
77 | core =
78 | pure
79 | [ ("Halide::Expr", [t|CxxExpr|])
80 | , ("Halide::Var", [t|CxxVar|])
81 | , ("Halide::RVar", [t|CxxRVar|])
82 | , ("Halide::VarOrRVar", [t|CxxVarOrRVar|])
83 | , ("Halide::Func", [t|CxxFunc|])
84 | , ("Halide::Internal::Parameter", [t|CxxParameter|])
85 | , ("Halide::ImageParam", [t|CxxImageParam|])
86 | , ("Halide::Callable", [t|CxxCallable|])
87 | , ("Halide::Target", [t|CxxTarget|])
88 | , ("Halide::JITUserContext", [t|CxxUserContext|])
89 | , ("std::vector", [t|CxxVector|])
90 | , ("std::string", [t|CxxString|])
91 | , ("halide_type_t", [t|HalideType|])
92 | ]
93 | other =
94 | optionals
95 | [ ("Halide::Internal::Dim", "Dim")
96 | , ("Halide::Internal::Dimension", "CxxDimension")
97 | , ("Halide::Internal::FusedPair", "FusedPair")
98 | , ("Halide::Internal::PrefetchDirective", "PrefetchDirective")
99 | , ("Halide::Internal::ReductionVariable", "ReductionVariable")
100 | , ("Halide::Internal::Split", "Split")
101 | , ("Halide::Internal::StageSchedule", "CxxStageSchedule")
102 | , ("Halide::Argument", "CxxArgument")
103 | , ("Halide::Buffer", "CxxBuffer")
104 | , ("Halide::LoopLevel", "CxxLoopLevel")
105 | , ("Halide::Stage", "CxxStage")
106 | , ("Halide::Range", "CxxRange")
107 | , ("Halide::RDom", "CxxRDom")
108 | , ("halide_buffer_t", "Language.Halide.Buffer.RawHalideBuffer")
109 | , ("halide_device_interface_t", "HalideDeviceInterface")
110 | , ("halide_dimension_t", "HalideDimension")
111 | , ("halide_trace_event_t", "TraceEvent")
112 | ]
113 | optional :: (CIdentifier, String) -> Q [(CIdentifier, TypeQ)]
114 | optional (cName, hsName) = do
115 | hsType <- lookupTypeName hsName
116 | pure $ maybe [] (\x -> [(cName, pure (TH.ConT x))]) hsType
117 | optionals :: [(CIdentifier, String)] -> Q [(CIdentifier, TypeQ)]
118 | optionals pairs = concat <$> mapM optional pairs
119 |
120 | defineExceptionHandler :: DecsQ
121 | defineExceptionHandler =
122 | C.verbatim
123 | "\
124 | \template \n\
125 | \auto handle_halide_exceptions(Func&& func) { \n\
126 | \ try { \n\
127 | \ return func(); \n\
128 | \ } catch(Halide::RuntimeError& e) { \n\
129 | \ throw std::runtime_error{e.what()}; \n\
130 | \ } catch(Halide::CompileError& e) { \n\
131 | \ throw std::runtime_error{e.what()}; \n\
132 | \ } catch(Halide::InternalError& e) { \n\
133 | \ throw std::runtime_error{e.what()}; \n\
134 | \ } catch(Halide::Error& e) { \n\
135 | \ throw std::runtime_error{e.what()}; \n\
136 | \ } \n\
137 | \} \n\
138 | \ \n\
139 | \template \n\
140 | \auto to_string_via_iostream(T const& x) -> std::string* { \n\
141 | \ std::ostringstream stream; \n\
142 | \ stream << x; \n\
143 | \ return new std::string{stream.str()}; \n\
144 | \} \n\
145 | \\n\
146 | \namespace Halide { namespace Internal {\n\
147 | \ std::string print_loop_nest(const std::vector &);\n\
148 | \} }\n\
149 | \"
150 |
--------------------------------------------------------------------------------
/src/Language/Halide/Dimension.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE AllowAmbiguousTypes #-}
2 | {-# LANGUAGE InstanceSigs #-}
3 | {-# LANGUAGE LambdaCase #-}
4 | {-# LANGUAGE OverloadedRecordDot #-}
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE ScopedTypeVariables #-}
7 | {-# LANGUAGE TemplateHaskell #-}
8 | {-# LANGUAGE TypeApplications #-}
9 | {-# OPTIONS_GHC -Wno-redundant-constraints #-}
10 |
11 | -- |
12 | -- Module : Language.Halide.Dimension
13 | -- Copyright : (c) Tom Westerhout, 2023
14 | module Language.Halide.Dimension
15 | ( Dimension (..)
16 | , setMin
17 | , setExtent
18 | , setStride
19 | , setEstimate
20 |
21 | -- * Internal
22 | , CxxDimension
23 | , wrapCxxDimension
24 | , withCxxDimension
25 | )
26 | where
27 |
28 | import Foreign.ForeignPtr
29 | import Foreign.Ptr (Ptr)
30 | import GHC.Records (HasField (..))
31 | import qualified Language.C.Inline as C
32 | import qualified Language.C.Inline.Unsafe as CU
33 | import Language.Halide.Buffer
34 | import Language.Halide.Context
35 | import Language.Halide.Expr
36 | import Language.Halide.Type
37 | import System.IO.Unsafe (unsafePerformIO)
38 | import Prelude hiding (tail)
39 |
40 | -- | Haskell counterpart of [@Halide::Internal::Dimension@](https://halide-lang.org/docs/class_halide_1_1_internal_1_1_dimension.html).
41 | data CxxDimension
42 |
43 | importHalide
44 |
45 | -- | Information about a buffer's dimension, such as the min, extent, and stride.
46 | newtype Dimension = Dimension (ForeignPtr CxxDimension)
47 |
48 | instance Show Dimension where
49 | showsPrec d dim =
50 | showParen (d > 10) $
51 | showString "Dimension { min="
52 | . shows dim.min
53 | . showString (", extent=" :: String)
54 | . shows dim.extent
55 | . showString (", stride=" :: String)
56 | . shows dim.stride
57 | . showString " }"
58 |
59 | instance HasField "min" Dimension (Expr Int32) where
60 | getField :: Dimension -> Expr Int32
61 | getField dim = unsafePerformIO $
62 | withCxxDimension dim $ \d ->
63 | cxxConstructExpr $ \ptr ->
64 | [CU.exp| void { new ($(Halide::Expr* ptr)) Halide::Expr{
65 | $(const Halide::Internal::Dimension* d)->min()} } |]
66 |
67 | -- | Set the min in a given dimension to equal the given expression. Setting the mins to
68 | -- zero may simplify some addressing math.
69 | --
70 | -- For more info, see [Halide::Internal::Dimension::set_min](https://halide-lang.org/docs/class_halide_1_1_internal_1_1_dimension.html#a84acaf7733391fdaea4f4cec24a60de2).
71 | setMin :: Expr Int32 -> Dimension -> IO Dimension
72 | setMin expr dim = do
73 | asExpr expr $ \n ->
74 | withCxxDimension dim $ \d ->
75 | [CU.exp| void {
76 | $(Halide::Internal::Dimension* d)->set_min(*$(const Halide::Expr* n)) } |]
77 | pure dim
78 |
79 | instance HasField "extent" Dimension (Expr Int32) where
80 | getField :: Dimension -> Expr Int32
81 | getField dim = unsafePerformIO $
82 | withCxxDimension dim $ \d ->
83 | cxxConstructExpr $ \ptr ->
84 | [CU.exp| void { new ($(Halide::Expr* ptr)) Halide::Expr{
85 | $(const Halide::Internal::Dimension* d)->extent()} } |]
86 |
87 | -- | Set the extent in a given dimension to equal the given expression.
88 | --
89 | -- Halide will generate runtime errors for Buffers that fail this check.
90 | --
91 | -- For more info, see [Halide::Internal::Dimension::set_extent](https://halide-lang.org/docs/class_halide_1_1_internal_1_1_dimension.html#a54111d8439a065bdaca5b9ff9bcbd630).
92 | setExtent :: Expr Int32 -> Dimension -> IO Dimension
93 | setExtent expr dim = do
94 | asExpr expr $ \n ->
95 | withCxxDimension dim $ \d ->
96 | [CU.exp| void {
97 | $(Halide::Internal::Dimension* d)->set_extent(*$(const Halide::Expr* n)) } |]
98 | pure dim
99 |
100 | instance HasField "max" Dimension (Expr Int32) where
101 | getField :: Dimension -> Expr Int32
102 | getField dim = unsafePerformIO $
103 | withCxxDimension dim $ \d ->
104 | cxxConstructExpr $ \ptr ->
105 | [CU.exp| void { new ($(Halide::Expr* ptr)) Halide::Expr{
106 | $(Halide::Internal::Dimension* d)->max()} } |]
107 |
108 | instance HasField "stride" Dimension (Expr Int32) where
109 | getField :: Dimension -> Expr Int32
110 | getField dim = unsafePerformIO $
111 | withCxxDimension dim $ \d ->
112 | cxxConstructExpr $ \ptr ->
113 | [CU.exp| void { new ($(Halide::Expr* ptr)) Halide::Expr{
114 | $(Halide::Internal::Dimension* d)->stride()} } |]
115 |
116 | -- | Set the stride in a given dimension to equal the given expression.
117 | --
118 | -- This is particularly useful to set when vectorizing. Known strides for the vectorized
119 | -- dimensions generate better code.
120 | --
121 | -- For more info, see [Halide::Internal::Dimension::set_stride](https://halide-lang.org/docs/class_halide_1_1_internal_1_1_dimension.html#a94f4c432a89907e2cc2aa908b5012cf8).
122 | setStride :: Expr Int32 -> Dimension -> IO Dimension
123 | setStride expr dim = do
124 | asExpr expr $ \n ->
125 | withCxxDimension dim $ \d ->
126 | [CU.exp| void {
127 | $(Halide::Internal::Dimension* d)->set_stride(*$(const Halide::Expr* n)) } |]
128 | pure dim
129 |
130 | -- | Set estimates for autoschedulers.
131 | setEstimate
132 | :: Expr Int32
133 | -- ^ @min@ estimate
134 | -> Expr Int32
135 | -- ^ @extent@ estimate
136 | -> Dimension
137 | -> IO Dimension
138 | setEstimate minExpr extentExpr dim = do
139 | asExpr minExpr $ \m ->
140 | asExpr extentExpr $ \e ->
141 | withCxxDimension dim $ \d ->
142 | [CU.exp| void {
143 | $(Halide::Internal::Dimension* d)->set_estimate(*$(const Halide::Expr* m),
144 | *$(const Halide::Expr* e)) } |]
145 | pure dim
146 |
147 | wrapCxxDimension :: Ptr CxxDimension -> IO Dimension
148 | wrapCxxDimension = fmap Dimension . newForeignPtr deleter
149 | where
150 | deleter = [C.funPtr| void deleteDimension(Halide::Internal::Dimension* p) { delete p; } |]
151 |
152 | withCxxDimension :: Dimension -> (Ptr CxxDimension -> IO a) -> IO a
153 | withCxxDimension (Dimension fp) = withForeignPtr fp
154 |
--------------------------------------------------------------------------------
/src/Language/Halide/LoopLevel.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE GADTs #-}
2 | {-# LANGUAGE InstanceSigs #-}
3 | {-# LANGUAGE LambdaCase #-}
4 | {-# LANGUAGE OverloadedRecordDot #-}
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE RankNTypes #-}
7 | {-# LANGUAGE ScopedTypeVariables #-}
8 | {-# LANGUAGE StandaloneDeriving #-}
9 | {-# LANGUAGE TemplateHaskell #-}
10 | {-# LANGUAGE TypeApplications #-}
11 |
12 | -- |
13 | -- Module : Language.Halide.LoopLevel
14 | -- Copyright : (c) Tom Westerhout, 2023
15 | module Language.Halide.LoopLevel
16 | ( LoopLevel (..)
17 | , LoopLevelTy (..)
18 | , SomeLoopLevel (..)
19 | , LoopAlignStrategy (..)
20 |
21 | -- * Internal
22 | , CxxLoopLevel
23 | , withCxxLoopLevel
24 | , wrapCxxLoopLevel
25 | )
26 | where
27 |
28 | import Control.Exception (bracket)
29 | import Data.Text (Text)
30 | import Foreign.ForeignPtr
31 | import Foreign.Marshal (toBool)
32 | import Foreign.Ptr (Ptr)
33 | import GHC.Records (HasField (..))
34 | import qualified Language.C.Inline as C
35 | import qualified Language.C.Inline.Cpp.Exception as C
36 | import qualified Language.C.Inline.Unsafe as CU
37 | import Language.Halide.Context
38 | import Language.Halide.Expr
39 | import Language.Halide.Type
40 | import Language.Halide.Utils
41 | import System.IO.Unsafe (unsafePerformIO)
42 | import Prelude hiding (min, tail)
43 |
44 | -- | Haskell counterpart of @Halide::LoopLevel@
45 | data CxxLoopLevel
46 |
47 | importHalide
48 |
49 | data LoopLevelTy = InlinedTy | RootTy | LockedTy
50 |
51 | -- | A reference to a site in a Halide statement at the top of the body of a particular for loop.
52 | data LoopLevel (t :: LoopLevelTy) where
53 | InlinedLoopLevel :: LoopLevel 'InlinedTy
54 | RootLoopLevel :: LoopLevel 'RootTy
55 | LoopLevel :: !(ForeignPtr CxxLoopLevel) -> LoopLevel 'LockedTy
56 |
57 | data SomeLoopLevel where
58 | SomeLoopLevel :: LoopLevel t -> SomeLoopLevel
59 |
60 | deriving stock instance Show SomeLoopLevel
61 |
62 | instance Eq SomeLoopLevel where
63 | (SomeLoopLevel InlinedLoopLevel) == (SomeLoopLevel InlinedLoopLevel) = True
64 | (SomeLoopLevel RootLoopLevel) == (SomeLoopLevel RootLoopLevel) = True
65 | (SomeLoopLevel a@(LoopLevel _)) == (SomeLoopLevel b@(LoopLevel _)) = a == b
66 | _ == _ = False
67 |
68 | instance Eq (LoopLevel t) where
69 | level1 == level2 =
70 | toBool . unsafePerformIO $
71 | withCxxLoopLevel level1 $ \l1 ->
72 | withCxxLoopLevel level2 $ \l2 ->
73 | [CU.exp| bool { *$(const Halide::LoopLevel* l1) == *$(const Halide::LoopLevel* l2) } |]
74 |
75 | instance Show (LoopLevel t) where
76 | showsPrec _ InlinedLoopLevel = showString "InlinedLoopLevel"
77 | showsPrec _ RootLoopLevel = showString "RootLoopLevel"
78 | showsPrec d level@(LoopLevel _) =
79 | showParen (d > 10) $
80 | showString "LoopLevel {func = "
81 | . shows (level.func :: Text)
82 | . showString ", var = "
83 | . shows (level.var :: Expr Int32)
84 | . showString "}"
85 |
86 | -- desc
87 | -- where
88 | -- desc = unpack . unsafePerformIO $
89 | -- withCxxLoopLevel level $ \l ->
90 | -- peekAndDeleteCxxString
91 | -- =<< [C.throwBlock| std::string* {
92 | -- return handle_halide_exceptions([=](){
93 | -- return new std::string{$(const Halide::LoopLevel* l)->to_string()};
94 | -- });
95 | -- } |]
96 |
97 | -- | Different ways to handle the case when the start/end of the loops of stages computed with (fused)
98 | -- are not aligned.
99 | data LoopAlignStrategy
100 | = -- | Shift the start of the fused loops to align.
101 | LoopAlignStart
102 | | -- | Shift the end of the fused loops to align.
103 | LoopAlignEnd
104 | | -- | 'computeWith' will make no attempt to align the start/end of the fused loops.
105 | LoopNoAlign
106 | | -- | By default, LoopAlignStrategy is set to 'LoopNoAlign'.
107 | LoopAlignAuto
108 | deriving stock (Show, Eq, Ord)
109 |
110 | instance Enum LoopAlignStrategy where
111 | fromEnum =
112 | fromIntegral . \case
113 | LoopAlignStart -> [CU.pure| int { static_cast(Halide::LoopAlignStrategy::AlignStart) } |]
114 | LoopAlignEnd -> [CU.pure| int { static_cast(Halide::LoopAlignStrategy::AlignEnd) } |]
115 | LoopNoAlign -> [CU.pure| int { static_cast(Halide::LoopAlignStrategy::NoAlign) } |]
116 | LoopAlignAuto -> [CU.pure| int { static_cast(Halide::LoopAlignStrategy::Auto) } |]
117 | toEnum k
118 | | fromIntegral k == [CU.pure| int { static_cast(Halide::LoopAlignStrategy::AlignStart) } |] = LoopAlignStart
119 | | fromIntegral k == [CU.pure| int { static_cast(Halide::LoopAlignStrategy::AlignEnd) } |] = LoopAlignEnd
120 | | fromIntegral k == [CU.pure| int { static_cast(Halide::LoopAlignStrategy::NoAlign) } |] = LoopNoAlign
121 | | fromIntegral k == [CU.pure| int { static_cast(Halide::LoopAlignStrategy::Auto) } |] = LoopAlignAuto
122 | | otherwise = error $ "invalid LoopAlignStrategy: " <> show k
123 |
124 | isInlined :: LoopLevel t -> Bool
125 | isInlined InlinedLoopLevel = True
126 | isInlined _ = False
127 |
128 | isRoot :: LoopLevel t -> Bool
129 | isRoot RootLoopLevel = True
130 | isRoot _ = False
131 |
132 | instance HasField "func" (LoopLevel 'LockedTy) Text where
133 | getField level = unsafePerformIO $
134 | withCxxLoopLevel level $ \level' ->
135 | peekAndDeleteCxxString
136 | =<< [CU.exp| std::string* {
137 | new std::string{$(const Halide::LoopLevel* level')->func()} } |]
138 |
139 | instance HasField "var" (LoopLevel 'LockedTy) (Expr Int32) where
140 | getField level = unsafePerformIO $
141 | withCxxLoopLevel level $ \level' ->
142 | wrapCxxVarOrRVar
143 | =<< [CU.exp| Halide::VarOrRVar* {
144 | new Halide::VarOrRVar{$(const Halide::LoopLevel* level')->var()} } |]
145 |
146 | wrapCxxLoopLevel :: Ptr CxxLoopLevel -> IO SomeLoopLevel
147 | wrapCxxLoopLevel p = do
148 | [C.throwBlock| void { handle_halide_exceptions([=]() { $(Halide::LoopLevel* p)->lock(); }); } |]
149 | inlined <-
150 | toBool
151 | <$> [C.throwBlock| bool {
152 | return handle_halide_exceptions([=](){
153 | return $(const Halide::LoopLevel* p)->is_inlined(); });
154 | } |]
155 | root <-
156 | toBool
157 | <$> [C.throwBlock| bool {
158 | return handle_halide_exceptions([=](){
159 | return $(const Halide::LoopLevel* p)->is_root(); });
160 | } |]
161 | let level
162 | | inlined = [CU.exp| void { delete $(Halide::LoopLevel *p) } |] >> pure (SomeLoopLevel InlinedLoopLevel)
163 | | root = [CU.exp| void { delete $(Halide::LoopLevel *p) } |] >> pure (SomeLoopLevel RootLoopLevel)
164 | | otherwise = do
165 | let deleter = [C.funPtr| void deleteLoopLevel(Halide::LoopLevel* p) { delete p; } |]
166 | SomeLoopLevel . LoopLevel <$> newForeignPtr deleter p
167 | level
168 |
169 | withCxxLoopLevel :: LoopLevel t -> (Ptr CxxLoopLevel -> IO a) -> IO a
170 | withCxxLoopLevel (LoopLevel fp) action = withForeignPtr fp action
171 | withCxxLoopLevel level action = do
172 | let allocate
173 | | isInlined level = [CU.exp| Halide::LoopLevel* { new Halide::LoopLevel{Halide::LoopLevel::inlined()} } |]
174 | | isRoot level = [CU.exp| Halide::LoopLevel* { new Halide::LoopLevel{Halide::LoopLevel::root()} } |]
175 | | otherwise = error "this should never happen"
176 | destroy p = [CU.exp| void { delete $(Halide::LoopLevel *p) } |]
177 | bracket allocate destroy action
178 |
--------------------------------------------------------------------------------
/src/Language/Halide/Prelude.hs:
--------------------------------------------------------------------------------
1 | module Language.Halide.Prelude
2 | ( (==)
3 | , (/=)
4 | , (+)
5 | , (-)
6 | )
7 | where
8 |
9 | import Data.Kind (Type)
10 | import Language.Halide.Expr
11 | import Language.Halide.Type
12 | import Prelude (Bool, undefined)
13 |
14 | type family Promoted a b :: Type
15 |
16 | infix 4 ==, /=
17 |
18 | (==) :: Expr a -> Expr b -> Expr Bool
19 | (==) = undefined
20 |
21 | (/=) :: Expr a -> Expr b -> Expr Bool
22 | (/=) = undefined
23 |
24 | infix 6 +, -
25 |
26 | (+) :: Expr a -> Expr b -> Expr (Promoted a b)
27 | (+) = undefined
28 |
29 | (-) :: Expr a -> Expr b -> Expr (Promoted a b)
30 | (-) = undefined
31 |
32 | infix 7 *, /
33 |
34 | (*) :: Expr a -> Expr b -> Expr (Promoted a b)
35 | (*) = undefined
36 |
37 | (/) :: Expr a -> Expr b -> Expr (Promoted a b)
38 | (/) = undefined
39 |
40 | mkExpr :: IsHalideType a => a -> Expr a
41 | mkExpr = undefined
42 |
--------------------------------------------------------------------------------
/src/Language/Halide/RedundantConstraints.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE ConstraintKinds #-}
2 | {-# OPTIONS_GHC -Wno-redundant-constraints #-}
3 |
4 | module Language.Halide.RedundantConstraints
5 | ( keepRedundantConstraint
6 | ) where
7 |
8 | -- | Can be used to silence individual "redundant constraint" warnings
9 | --
10 | -- > foo :: ConstraintUsefulForDebugging => ...
11 | -- > foo =
12 | -- > ..
13 | -- > where
14 | -- > _ = keepRedundantConstraint (Proxy @ConstraintUsefulForDebugging))
15 | --
16 | -- __Note:__ this function is taken from [input-output-hk/ouroboros-network](https://github.com/input-output-hk/ouroboros-network/blob/master/ouroboros-consensus/src/Ouroboros/Consensus/Util/RedundantConstraints.hs).
17 | keepRedundantConstraint :: c => proxy c -> ()
18 | keepRedundantConstraint _ = ()
19 |
--------------------------------------------------------------------------------
/src/Language/Halide/Trace.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE LambdaCase #-}
2 | {-# LANGUAGE QuasiQuotes #-}
3 | {-# LANGUAGE ScopedTypeVariables #-}
4 | {-# LANGUAGE TemplateHaskell #-}
5 | {-# LANGUAGE TupleSections #-}
6 | {-# LANGUAGE TypeApplications #-}
7 |
8 | -- |
9 | -- Module : Language.Halide.Trace
10 | -- Copyright : (c) Tom Westerhout, 2023
11 | module Language.Halide.Trace
12 | ( TraceEvent (..)
13 | , TraceEventCode (..)
14 | , TraceLoadStoreContents (..)
15 | , setCustomTrace
16 | , traceStores
17 | , traceLoads
18 | , collectIterationOrder
19 | )
20 | where
21 |
22 | import Control.Concurrent.MVar
23 | import Control.Exception (bracket, bracket_)
24 | import Data.ByteString (packCString)
25 | import Data.Int (Int32)
26 | import Data.Text (Text)
27 | import Data.Text.Encoding (decodeUtf8)
28 | import Foreign.Marshal (peekArray)
29 | import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr)
30 | import Foreign.Storable
31 | import GHC.TypeLits
32 | import Language.C.Inline qualified as C
33 | import Language.C.Inline.Unsafe qualified as CU
34 | import Language.Halide.Buffer
35 | import Language.Halide.Context
36 | import Language.Halide.Dimension
37 | import Language.Halide.Func
38 | import Language.Halide.LoopLevel
39 | import Language.Halide.Type
40 | import Prelude hiding (min, tail)
41 |
42 | -- | Haskell counterpart of [@halide_trace_event_code_t@](https://halide-lang.org/docs/_halide_runtime_8h.html#a485130f12eb8bb5fa5a9478eeb6b0dfa).
43 | data TraceEventCode
44 | = TraceLoad
45 | | TraceStore
46 | | TraceBeginRealization
47 | | TraceEndRealization
48 | | TraceProduce
49 | | TraceEndProduce
50 | | TraceConsume
51 | | TraceEndConsume
52 | | TraceBeginPipeline
53 | | TraceEndPipeline
54 | | TraceTag
55 | deriving stock (Show, Eq, Ord)
56 |
57 | data TraceLoadStoreContents = TraceLoadStoreContents
58 | { valuePtr :: !(Ptr ())
59 | , valueType :: !HalideType
60 | , coordinates :: ![Int]
61 | }
62 | deriving stock (Show)
63 |
64 | data TraceEvent = TraceEvent
65 | { funcName :: !Text
66 | , eventCode :: !TraceEventCode
67 | , loadStoreContents :: !(Maybe TraceLoadStoreContents)
68 | }
69 | deriving stock (Show)
70 |
71 | importHalide
72 |
73 | instance Enum TraceEventCode where
74 | fromEnum =
75 | fromIntegral . \case
76 | TraceLoad -> [CU.pure| int { halide_trace_load } |]
77 | TraceStore -> [CU.pure| int { halide_trace_store } |]
78 | TraceBeginRealization -> [CU.pure| int { halide_trace_begin_realization } |]
79 | TraceEndRealization -> [CU.pure| int { halide_trace_end_realization } |]
80 | TraceProduce -> [CU.pure| int { halide_trace_produce } |]
81 | TraceEndProduce -> [CU.pure| int { halide_trace_end_produce } |]
82 | TraceConsume -> [CU.pure| int { halide_trace_consume } |]
83 | TraceEndConsume -> [CU.pure| int { halide_trace_end_consume } |]
84 | TraceBeginPipeline -> [CU.pure| int { halide_trace_begin_pipeline } |]
85 | TraceEndPipeline -> [CU.pure| int { halide_trace_end_pipeline } |]
86 | TraceTag -> [CU.pure| int { halide_trace_tag } |]
87 | toEnum k
88 | | fromIntegral k == [CU.pure| int { halide_trace_load } |] = TraceLoad
89 | | fromIntegral k == [CU.pure| int { halide_trace_store } |] = TraceStore
90 | | fromIntegral k == [CU.pure| int { halide_trace_begin_realization } |] = TraceBeginRealization
91 | | fromIntegral k == [CU.pure| int { halide_trace_end_realization } |] = TraceEndRealization
92 | | fromIntegral k == [CU.pure| int { halide_trace_produce } |] = TraceProduce
93 | | fromIntegral k == [CU.pure| int { halide_trace_end_produce } |] = TraceEndProduce
94 | | fromIntegral k == [CU.pure| int { halide_trace_consume } |] = TraceConsume
95 | | fromIntegral k == [CU.pure| int { halide_trace_end_consume } |] = TraceEndConsume
96 | | fromIntegral k == [CU.pure| int { halide_trace_begin_pipeline } |] = TraceBeginPipeline
97 | | fromIntegral k == [CU.pure| int { halide_trace_end_pipeline } |] = TraceEndPipeline
98 | | fromIntegral k == [CU.pure| int { halide_trace_tag } |] = TraceTag
99 | | otherwise = error $ "invalid TraceEventCode: " <> show k
100 |
101 | peekTraceLoadStoreContents :: Ptr TraceEvent -> IO TraceLoadStoreContents
102 | peekTraceLoadStoreContents p = do
103 | v <- [CU.exp| void* { $(const halide_trace_event_t* p)->value } |]
104 | tp <- peek =<< [CU.exp| const halide_type_t* { &$(const halide_trace_event_t* p)->type } |]
105 | n <- fromIntegral <$> [CU.exp| int { $(const halide_trace_event_t* p)->dimensions } |]
106 | cs <- peekArray n =<< [CU.exp| const int32_t* { $(const halide_trace_event_t* p)->coordinates } |]
107 | pure $ TraceLoadStoreContents v tp (fromIntegral <$> cs)
108 |
109 | peekTraceEvent :: Ptr TraceEvent -> IO TraceEvent
110 | peekTraceEvent p = do
111 | f <-
112 | fmap decodeUtf8 $
113 | packCString
114 | =<< [CU.exp| const char* { $(const halide_trace_event_t* p)->func } |]
115 | c <- toEnum . fromIntegral <$> [CU.exp| int { $(const halide_trace_event_t* p)->event } |]
116 | contents <-
117 | case c of
118 | TraceLoad -> Just <$> peekTraceLoadStoreContents p
119 | TraceStore -> Just <$> peekTraceLoadStoreContents p
120 | _ -> pure Nothing
121 | pure $ TraceEvent f c contents
122 |
123 | withTrace
124 | :: (TraceEvent -> IO ()) -> (FunPtr (Ptr CxxUserContext -> Ptr TraceEvent -> IO Int32) -> IO a) -> IO a
125 | withTrace customTrace = bracket allocate destroy
126 | where
127 | allocate = do
128 | $(C.mkFunPtr [t|Ptr CxxUserContext -> Ptr TraceEvent -> IO Int32|]) $ \_ p ->
129 | peekTraceEvent p >>= customTrace >> pure 0
130 | destroy = freeHaskellFunPtr
131 |
132 | setCustomTrace
133 | :: KnownNat n
134 | => (TraceEvent -> IO ())
135 | -- ^ Custom trace function
136 | -> Func t n a
137 | -- ^ For which func to enable it
138 | -> IO b
139 | -- ^ For the duration of which computation to enable it
140 | -> IO b
141 | setCustomTrace customTrace f action =
142 | withTrace customTrace $ \tracePtr ->
143 | bracket_ (set tracePtr) unset action
144 | where
145 | set tracePtr =
146 | withFunc f $ \f' ->
147 | [CU.block| void {
148 | auto& func = *$(Halide::Func* f');
149 | func.jit_handlers().custom_trace = $(int32_t (*tracePtr)(Halide::JITUserContext*, const halide_trace_event_t*));
150 | } |]
151 | unset =
152 | withFunc f $ \f' ->
153 | [CU.block| void {
154 | auto& func = *$(Halide::Func* f');
155 | func.jit_handlers().custom_trace = nullptr;
156 | } |]
157 |
158 | traceStores :: KnownNat n => Func t n a -> IO (Func t n a)
159 | traceStores f = do
160 | withFunc f $ \f' ->
161 | [CU.exp| void { $(Halide::Func* f')->trace_stores() } |]
162 | pure f
163 |
164 | traceLoads :: KnownNat n => Func t n a -> IO (Func t n a)
165 | traceLoads f = do
166 | withFunc f $ \f' ->
167 | [CU.exp| void { $(Halide::Func* f')->trace_loads() } |]
168 | pure f
169 |
170 | collectIterationOrder
171 | :: KnownNat n
172 | => (TraceEventCode -> Bool)
173 | -> Func t n a
174 | -> IO b
175 | -> IO ([[Int]], b)
176 | collectIterationOrder cond f action = do
177 | m <- newMVar []
178 | let tracer (TraceEvent _ c' (Just payload))
179 | | cond c' = modifyMVar_ m $ pure . (payload.coordinates :)
180 | tracer _ = pure ()
181 | setCustomTrace tracer f $ do
182 | r <- action
183 | cs <- readMVar m
184 | pure (reverse cs, r)
185 |
--------------------------------------------------------------------------------
/src/Language/Halide/Type.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE AllowAmbiguousTypes #-}
2 | {-# LANGUAGE DeriveLift #-}
3 | {-# LANGUAGE GADTs #-}
4 | {-# LANGUAGE InstanceSigs #-}
5 | {-# LANGUAGE OverloadedStrings #-}
6 | {-# LANGUAGE PolyKinds #-}
7 | {-# LANGUAGE QuasiQuotes #-}
8 | {-# LANGUAGE TemplateHaskell #-}
9 | {-# LANGUAGE TypeFamilyDependencies #-}
10 | {-# LANGUAGE UndecidableInstances #-}
11 | {-# OPTIONS_GHC -Wno-unused-local-binds -Wno-unused-matches #-}
12 |
13 | -- |
14 | -- Module : Language.Halide.Type
15 | -- Description : Low-level types
16 | -- Copyright : (c) Tom Westerhout, 2023
17 | module Language.Halide.Type
18 | ( HalideTypeCode (..)
19 | , HalideType (..)
20 | , IsHalideType (..)
21 | , CxxExpr
22 | , CxxVar
23 | , CxxRVar
24 | , CxxVarOrRVar
25 | , CxxFunc
26 | , CxxParameter
27 | , CxxImageParam
28 | , CxxVector
29 | , CxxUserContext
30 | , CxxCallable
31 | , CxxTarget
32 | , CxxStageSchedule
33 | , CxxString
34 | , Arguments (..)
35 | , Length
36 | , Append
37 | , Concat
38 | , argumentsAppend
39 | , FunctionArguments
40 | , FunctionReturn
41 | , All
42 | , UnCurry (..)
43 | , Curry (..)
44 | , defineIsHalideTypeInstances
45 | , instanceHasCxxVector
46 | , HasCxxVector (..)
47 | , instanceCxxConstructible
48 | , CxxConstructible (..)
49 | -- defineCastableInstances,
50 | -- defineCurriedTypeFamily,
51 | -- defineUnCurriedTypeFamily,
52 | -- defineCurryInstances,
53 | -- defineUnCurryInstances,
54 | )
55 | where
56 |
57 | import Data.Coerce
58 | import Data.Constraint
59 | import Data.Int
60 | import Data.Kind (Type)
61 | import Data.Text qualified as T
62 | import Data.Word
63 | import Foreign.C.Types
64 | import Foreign.ForeignPtr
65 | import Foreign.Ptr
66 | import Foreign.Storable
67 | import GHC.ForeignPtr (mallocForeignPtrAlignedBytes)
68 | import GHC.TypeLits
69 | import Language.C.Inline qualified as C
70 | import Language.C.Inline.Unsafe qualified as CU
71 | import Language.Haskell.TH qualified as TH
72 | import Language.Haskell.TH.Syntax (Lift)
73 |
74 | -- | Haskell counterpart of @Halide::Expr@.
75 | data CxxExpr
76 |
77 | -- | Haskell counterpart of @Halide::Var@.
78 | data CxxVar
79 |
80 | -- | Haskell counterpart of @Halide::RVar@.
81 | data CxxRVar
82 |
83 | -- | Haskell counterpart of @Halide::VarOrRVar@.
84 | data CxxVarOrRVar
85 |
86 | -- | Haskell counterpart of @Halide::Internal::Parameter@.
87 | data CxxParameter
88 |
89 | -- | Haskell counterpart of @Halide::ImageParam@.
90 | data CxxImageParam
91 |
92 | -- | Haskell counterpart of @Halide::Func@.
93 | data CxxFunc
94 |
95 | -- | Haskell counterpart of @Halide::JITUserContext@.
96 | data CxxUserContext
97 |
98 | -- | Haskell counterpart of @Halide::Callable@.
99 | data CxxCallable
100 |
101 | -- | Haskell counterpart of @Halide::Target@.
102 | data CxxTarget
103 |
104 | -- | Haskell counterpart of @std::vector@.
105 | data CxxVector a
106 |
107 | -- | Haskell counterpart of @Halide::Internal::StageSchedule@.
108 | data CxxStageSchedule
109 |
110 | -- | Haskell counterpart of @std::string@
111 | data CxxString
112 |
113 | class CxxConstructible a where
114 | cxxSizeOf :: Int
115 | cxxConstruct :: (Ptr a -> IO ()) -> IO (ForeignPtr a)
116 |
117 | cxxConstructWithDeleter :: Int -> FinalizerPtr a -> (Ptr a -> IO ()) -> IO (ForeignPtr a)
118 | cxxConstructWithDeleter size deleter constructor = do
119 | fp <- mallocForeignPtrAlignedBytes size align
120 | withForeignPtr fp constructor
121 | addForeignPtrFinalizer deleter fp
122 | pure fp
123 | where
124 | align = 64
125 |
126 | -- data Split =
127 | -- SplitVar !Text !Text !Text !(Expr Int32) !
128 |
129 | -- | Haskell counterpart of @halide_type_code_t@.
130 | data HalideTypeCode
131 | = HalideTypeInt
132 | | HalideTypeUInt
133 | | HalideTypeFloat
134 | | HalideTypeHandle
135 | | HalideTypeBfloat
136 | deriving stock (Read, Show, Eq, Lift)
137 |
138 | instance Enum HalideTypeCode where
139 | fromEnum :: HalideTypeCode -> Int
140 | fromEnum x = case x of
141 | HalideTypeInt -> 0
142 | HalideTypeUInt -> 1
143 | HalideTypeFloat -> 2
144 | HalideTypeHandle -> 3
145 | HalideTypeBfloat -> 4
146 | toEnum :: Int -> HalideTypeCode
147 | toEnum x = case x of
148 | 0 -> HalideTypeInt
149 | 1 -> HalideTypeUInt
150 | 2 -> HalideTypeFloat
151 | 3 -> HalideTypeHandle
152 | 4 -> HalideTypeBfloat
153 | _ -> error $ "invalid HalideTypeCode: " <> show x
154 |
155 | -- | Haskell counterpart of @halide_type_t@.
156 | data HalideType = HalideType
157 | { halideTypeCode :: !HalideTypeCode
158 | , halideTypeBits :: {-# UNPACK #-} !Word8
159 | , halideTypeLanes :: {-# UNPACK #-} !Word16
160 | }
161 | deriving stock (Read, Show, Eq)
162 |
163 | instance Storable HalideType where
164 | sizeOf :: HalideType -> Int
165 | sizeOf _ = 4
166 | alignment :: HalideType -> Int
167 | alignment _ = 4
168 | peek :: Ptr HalideType -> IO HalideType
169 | peek p =
170 | HalideType
171 | <$> (toEnum . (fromIntegral :: Word8 -> Int) <$> peekByteOff p 0)
172 | <*> peekByteOff p 1
173 | <*> peekByteOff p 2
174 | poke :: Ptr HalideType -> HalideType -> IO ()
175 | poke p (HalideType code bits lanes) = do
176 | pokeByteOff p 0 . (fromIntegral :: Int -> Word8) . fromEnum $ code
177 | pokeByteOff p 1 bits
178 | pokeByteOff p 2 lanes
179 |
180 | -- | Specifies that a type is supported by Halide.
181 | class Storable a => IsHalideType a where
182 | halideTypeFor :: proxy a -> HalideType
183 | toCxxExpr :: a -> IO (ForeignPtr CxxExpr)
184 |
185 | -- | Helper function to coerce 'Float' to 'CFloat' and 'Double' to 'CDouble'
186 | -- before passing them to inline-c quasiquotes. This is needed because inline-c
187 | -- assumes that @float@ in C corresponds to 'CFloat' in Haskell.
188 | optionallyCast :: String -> TH.TypeQ -> TH.ExpQ
189 | optionallyCast cType hsType' = do
190 | hsType <- hsType'
191 | hsTargetType <- C.getHaskellType False cType
192 | if hsType == hsTargetType then [e|id|] else [e|coerce|]
193 |
194 | -- | Template Haskell splice that defines instances of 'IsHalideType' for a
195 | -- given Haskell type.
196 | instanceIsHalideType :: (String, TH.TypeQ, HalideTypeCode) -> TH.DecsQ
197 | instanceIsHalideType (cType, hsType, typeCode) =
198 | C.substitute
199 | [("T", \x -> "$(" <> cType <> " " <> x <> ")")]
200 | [d|
201 | instance IsHalideType $hsType where
202 | halideTypeFor _ = HalideType typeCode bits 1
203 | where
204 | bits = fromIntegral $ 8 * sizeOf (undefined :: $hsType)
205 | toCxxExpr y =
206 | cxxConstruct $ \ptr ->
207 | [CU.exp| void { new ($(Halide::Expr* ptr)) Halide::Expr{@T(x)} } |]
208 | where
209 | x = $(optionallyCast cType hsType) y
210 | |]
211 |
212 | -- | Derive 'IsHalideType' instances for all supported types.
213 | defineIsHalideTypeInstances :: TH.DecsQ
214 | defineIsHalideTypeInstances = concat <$> mapM instanceIsHalideType halideTypes
215 |
216 | instanceCxxConstructible :: String -> TH.DecsQ
217 | instanceCxxConstructible cType =
218 | C.substitute
219 | [ ("T", const cType)
220 | , ("Deleter", const $ "deleter(" <> cType <> "* p)")
221 | , ("Class", const . T.unpack . snd $ T.breakOnEnd "::" (T.pack cType))
222 | ]
223 | [d|
224 | instance CxxConstructible $(C.getHaskellType False cType) where
225 | cxxSizeOf = fromIntegral [CU.pure| size_t { sizeof(@T()) } |]
226 | cxxConstruct = cxxConstructWithDeleter size deleter
227 | where
228 | size = fromIntegral [CU.pure| size_t { sizeof(@T()) } |]
229 | deleter = [C.funPtr| void @Deleter() { p->~@Class()(); } |]
230 | |]
231 |
232 | -- | Specifies that a given Haskell type can be used with @std::vector@.
233 | --
234 | -- E.g. if we have @HasCxxVector Int16@, then using @std::vector*@
235 | -- in inline-c quotes will work.
236 | class HasCxxVector a where
237 | newCxxVector :: Maybe Int -> IO (Ptr (CxxVector a))
238 | deleteCxxVector :: Ptr (CxxVector a) -> IO ()
239 | cxxVectorSize :: Ptr (CxxVector a) -> IO Int
240 | cxxVectorPushBack :: Ptr (CxxVector a) -> Ptr a -> IO ()
241 | cxxVectorData :: Ptr (CxxVector a) -> IO (Ptr a)
242 | peekCxxVector :: Storable a => Ptr (CxxVector a) -> IO [a]
243 |
244 | -- | Template Haskell splice that defines an instance of 'HasCxxVector' for a given C type name.
245 | instanceHasCxxVector :: String -> TH.DecsQ
246 | instanceHasCxxVector cType =
247 | C.substitute
248 | [ ("T", const cType)
249 | , ("VEC", \var -> "$(std::vector<" ++ cType ++ ">* " ++ var ++ ")")
250 | ]
251 | [d|
252 | instance HasCxxVector $(C.getHaskellType False cType) where
253 | newCxxVector maybeSize = do
254 | v <- [CU.exp| std::vector<@T()>* { new std::vector<@T()>() } |]
255 | case maybeSize of
256 | Just size ->
257 | let n = fromIntegral size
258 | in [CU.exp| void { @VEC(v)->reserve($(size_t n)) } |]
259 | Nothing -> pure ()
260 | pure v
261 | deleteCxxVector vec = [CU.exp| void { delete @VEC(vec) } |]
262 | cxxVectorSize vec = fromIntegral <$> [CU.exp| size_t { @VEC(vec)->size() } |]
263 | cxxVectorPushBack vec x = [CU.exp| void { @VEC(vec)->push_back(*$(@T()* x)) } |]
264 | cxxVectorData vec = [CU.exp| @T()* { @VEC(vec)->data() } |]
265 | peekCxxVector vec = do
266 | n <- cxxVectorSize vec
267 | allocaArray n $ \out -> do
268 | [CU.block| void {
269 | auto const& vec = *@VEC(vec);
270 | auto* out = $(@T()* out);
271 | std::uninitialized_copy(std::begin(vec), std::end(vec), out);
272 | } |]
273 | peekArray n out
274 | |]
275 |
276 | -- | List of all supported types.
277 | halideTypes :: [(String, TH.TypeQ, HalideTypeCode)]
278 | halideTypes =
279 | [ ("float", [t|Float|], HalideTypeFloat)
280 | , ("float", [t|CFloat|], HalideTypeFloat)
281 | , ("double", [t|Double|], HalideTypeFloat)
282 | , ("double", [t|CDouble|], HalideTypeFloat)
283 | , ("int8_t", [t|Int8|], HalideTypeInt)
284 | , ("int16_t", [t|Int16|], HalideTypeInt)
285 | , ("int32_t", [t|Int32|], HalideTypeInt)
286 | , ("int64_t", [t|Int64|], HalideTypeInt)
287 | , ("uint8_t", [t|Word8|], HalideTypeUInt)
288 | , ("uint16_t", [t|Word16|], HalideTypeUInt)
289 | , ("uint32_t", [t|Word32|], HalideTypeUInt)
290 | , ("uint64_t", [t|Word64|], HalideTypeUInt)
291 | ]
292 |
293 | infixr 5 :::
294 |
295 | -- | A heterogeneous list.
296 | data Arguments (k :: [Type]) where
297 | Nil :: Arguments '[]
298 | (:::) :: !t -> !(Arguments ts) -> Arguments (t ': ts)
299 |
300 | -- | A type family that returns the length of a type-level list.
301 | type family Length (xs :: [k]) :: Nat where
302 | Length '[] = 0
303 | Length (x ': xs) = 1 + Length xs
304 |
305 | -- | Append to a type-level list.
306 | type family Append (xs :: [k]) (y :: k) :: [k] where
307 | Append '[] y = '[y]
308 | Append (x ': xs) y = x ': Append xs y
309 |
310 | type family Concat (xs :: [k]) (ys :: [k]) :: [k] where
311 | Concat '[] ys = ys
312 | Concat (x ': xs) ys = x ': Concat xs ys
313 |
314 | -- | Append a value to 'Arguments'
315 | argumentsAppend :: Arguments xs -> t -> Arguments (Append xs t)
316 | argumentsAppend = go
317 | where
318 | go :: forall xs t. Arguments xs -> t -> Arguments (Append xs t)
319 | go Nil y = y ::: Nil
320 | go (x ::: xs) y = x ::: go xs y
321 |
322 | -- | Return the list of arguments to of a function type.
323 | type family FunctionArguments (f :: Type) :: [Type] where
324 | FunctionArguments (a -> b) = a ': FunctionArguments b
325 | FunctionArguments a = '[]
326 |
327 | -- | Get the return type of a function.
328 | type family FunctionReturn (f :: Type) :: Type where
329 | FunctionReturn (a -> b) = FunctionReturn b
330 | FunctionReturn a = a
331 |
332 | -- | Apply constraint to all types in a list.
333 | type family All (c :: Type -> Constraint) (ts :: [Type]) = (p :: Constraint) | p -> ts where
334 | All c '[] = ()
335 | All c (t ': ts) = (c t, All c ts)
336 |
337 | -- | A helper typeclass to convert a normal curried function to a function that
338 | -- takes 'Arguments' as input.
339 | --
340 | -- For instance, if we have a function @f :: Int -> Float -> Double@, then it
341 | -- will be converted to @f' :: Arguments '[Int, Float] -> Double@.
342 | class UnCurry (f :: Type) (args :: [Type]) (r :: Type) | args r -> f, args f -> r where
343 | uncurryG :: f -> Arguments args -> r
344 |
345 | instance (FunctionArguments f ~ '[], FunctionReturn f ~ r, f ~ r) => UnCurry f '[] r where
346 | uncurryG f Nil = f
347 | {-# INLINE uncurryG #-}
348 |
349 | instance (UnCurry f args r) => UnCurry (a -> f) (a ': args) r where
350 | uncurryG f (a ::: args) = uncurryG (f a) args
351 | {-# INLINE uncurryG #-}
352 |
353 | -- | A helper typeclass to convert a function that takes 'Arguments' as input
354 | -- into a normal curried function. This is the inverse of 'UnCurry'.
355 | --
356 | -- For instance, if we have a function @f :: Arguments '[Int, Float] -> Double@, then
357 | -- it will be converted to @f' :: Int -> Float -> Double@.
358 | class Curry (args :: [Type]) (r :: Type) (f :: Type) | args r -> f where
359 | curryG :: (Arguments args -> r) -> f
360 |
361 | instance Curry '[] r r where
362 | curryG f = f Nil
363 | {-# INLINE curryG #-}
364 |
365 | instance Curry args r f => Curry (a ': args) r (a -> f) where
366 | curryG f a = curryG (\args -> f (a ::: args))
367 |
--------------------------------------------------------------------------------
/src/Language/Halide/Utils.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE QuasiQuotes #-}
2 | {-# LANGUAGE TemplateHaskell #-}
3 |
4 | -- |
5 | -- Module : Language.Halide.Utils
6 | -- Description : Utilities for writing FFI code
7 | -- Copyright : (c) Tom Westerhout, 2023
8 | module Language.Halide.Utils
9 | ( peekCxxString
10 | , peekAndDeleteCxxString
11 | ) where
12 |
13 | import Data.ByteString (packCString)
14 | import Data.Text (Text)
15 | import qualified Data.Text.Encoding as T
16 | import Foreign.Ptr (Ptr)
17 | import qualified Language.C.Inline.Unsafe as CU
18 | import Language.Halide.Context
19 | import Language.Halide.Type
20 |
21 | importHalide
22 |
23 | -- | Convert a pointer to @std::string@ into a string.
24 | --
25 | -- It properly handles unicode characters.
26 | peekCxxString :: Ptr CxxString -> IO Text
27 | peekCxxString p =
28 | fmap T.decodeUtf8 $
29 | packCString
30 | =<< [CU.exp| char const* { $(const std::string* p)->c_str() } |]
31 |
32 | -- | Call 'peekCxxString' and @delete@ the pointer.
33 | peekAndDeleteCxxString :: Ptr CxxString -> IO Text
34 | peekAndDeleteCxxString p = do
35 | s <- peekCxxString p
36 | [CU.exp| void { delete $(const std::string* p) } |]
37 | pure s
38 |
--------------------------------------------------------------------------------
/template/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2023, twesterhout
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of twesterhout nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 |
--------------------------------------------------------------------------------
/template/README.md:
--------------------------------------------------------------------------------
1 | # halide-haskell playground
2 |
3 | This is a template repo to get started with using [halide-haskell](https://github.com/twesterhout/halide-haskell).
4 |
5 | Type
6 |
7 | ```console
8 | $ nix flake init github:twesterhout/halide-haskell-playground
9 | ```
10 |
11 | and you're good to go. You can `nix develop` and start hacking or `nix build` to make sure everything works.
12 |
--------------------------------------------------------------------------------
/template/flake.lock:
--------------------------------------------------------------------------------
1 | {
2 | "nodes": {
3 | "flake-compat": {
4 | "flake": false,
5 | "locked": {
6 | "lastModified": 1673956053,
7 | "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=",
8 | "owner": "edolstra",
9 | "repo": "flake-compat",
10 | "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9",
11 | "type": "github"
12 | },
13 | "original": {
14 | "owner": "edolstra",
15 | "repo": "flake-compat",
16 | "type": "github"
17 | }
18 | },
19 | "flake-utils": {
20 | "inputs": {
21 | "systems": "systems"
22 | },
23 | "locked": {
24 | "lastModified": 1685518550,
25 | "narHash": "sha256-o2d0KcvaXzTrPRIo0kOLV0/QXHhDQ5DTi+OxcjO8xqY=",
26 | "owner": "numtide",
27 | "repo": "flake-utils",
28 | "rev": "a1720a10a6cfe8234c0e93907ffe81be440f4cef",
29 | "type": "github"
30 | },
31 | "original": {
32 | "owner": "numtide",
33 | "repo": "flake-utils",
34 | "type": "github"
35 | }
36 | },
37 | "nix-filter": {
38 | "locked": {
39 | "lastModified": 1681154353,
40 | "narHash": "sha256-MCJ5FHOlbfQRFwN0brqPbCunLEVw05D/3sRVoNVt2tI=",
41 | "owner": "numtide",
42 | "repo": "nix-filter",
43 | "rev": "f529f42792ade8e32c4be274af6b6d60857fbee7",
44 | "type": "github"
45 | },
46 | "original": {
47 | "owner": "numtide",
48 | "repo": "nix-filter",
49 | "type": "github"
50 | }
51 | },
52 | "nixpkgs": {
53 | "locked": {
54 | "lastModified": 1686420590,
55 | "narHash": "sha256-pZsmT8OVlyFfFks6d5e8jHIRL3aN6x9or90wVtFhR1Q=",
56 | "owner": "nixos",
57 | "repo": "nixpkgs",
58 | "rev": "f93429ebe8d013c1757a68675197799bfc1a1917",
59 | "type": "github"
60 | },
61 | "original": {
62 | "owner": "nixos",
63 | "ref": "haskell-updates",
64 | "repo": "nixpkgs",
65 | "type": "github"
66 | }
67 | },
68 | "root": {
69 | "inputs": {
70 | "flake-compat": "flake-compat",
71 | "flake-utils": "flake-utils",
72 | "nix-filter": "nix-filter",
73 | "nixpkgs": "nixpkgs"
74 | }
75 | },
76 | "systems": {
77 | "locked": {
78 | "lastModified": 1681028828,
79 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
80 | "owner": "nix-systems",
81 | "repo": "default",
82 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
83 | "type": "github"
84 | },
85 | "original": {
86 | "owner": "nix-systems",
87 | "repo": "default",
88 | "type": "github"
89 | }
90 | }
91 | },
92 | "root": "root",
93 | "version": 7
94 | }
95 |
--------------------------------------------------------------------------------
/template/flake.nix:
--------------------------------------------------------------------------------
1 | {
2 | description = "A minimal Haskell project using halide-haskell";
3 |
4 | nixConfig = {
5 | extra-experimental-features = "nix-command flakes";
6 | extra-substituters = "https://halide-haskell.cachix.org";
7 | extra-trusted-public-keys = "halide-haskell.cachix.org-1:cFPqtShCsH4aNjn2q4PHb39Omtd/FWRhrkTBcSrtNKQ=";
8 | allow-import-from-derivation = true;
9 | };
10 |
11 | inputs = {
12 | nixpkgs.url = "github:nixos/nixpkgs/haskell-updates";
13 | flake-utils.url = "github:numtide/flake-utils";
14 | nix-filter.url = "github:numtide/nix-filter";
15 | flake-compat = {
16 | url = "github:edolstra/flake-compat";
17 | flake = false;
18 | };
19 | };
20 |
21 | outputs = inputs: inputs.flake-utils.lib.eachDefaultSystem
22 | (system:
23 | with builtins;
24 | let
25 | pkgs = import inputs.nixpkgs { inherit system; };
26 |
27 | # Only consider source dirs and .cabal files as the source to our Haskell package.
28 | # This allows the project to rebuild only when the source files change.
29 | src = inputs.nix-filter.lib {
30 | root = ./.;
31 | include = [
32 | "src"
33 | "test"
34 | (inputs.nix-filter.lib.matchExt "cabal")
35 | "README.md"
36 | "LICENSE"
37 | ];
38 | };
39 |
40 | ghcVersion = "945";
41 | haskellPackages = pkgs.haskell.packages."ghc${ghcVersion}".override {
42 | overrides = self: suprt: {
43 | halide-haskell-playground =
44 | (self.callCabal2nix "halide-haskell-playground" src { });
45 | };
46 | };
47 |
48 | in
49 | {
50 | packages.default = haskellPackages.halide-haskell-playground;
51 | devShells.default = haskellPackages.shellFor {
52 | packages = ps: with ps; [
53 | halide-haskell-playground
54 | ];
55 | withHoogle = true;
56 | nativeBuildInputs = with pkgs; with haskellPackages; [
57 | # Building and testing
58 | cabal-install
59 | # Language servers
60 | haskell-language-server
61 | nil
62 | # Formatters
63 | fourmolu
64 | cabal-fmt
65 | nixpkgs-fmt
66 | ];
67 | };
68 | # The formatter to use for .nix files (but not .hs files)
69 | # Allows us to run `nix fmt` to reformat nix files.
70 | formatter = pkgs.nixpkgs-fmt;
71 | });
72 | }
73 |
--------------------------------------------------------------------------------
/template/halide-haskell-playground.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-haskell-playground
3 | version: 0.0.1.0
4 |
5 | -- synopsis:
6 | -- description:
7 | license: BSD-3-Clause
8 | license-file: LICENSE
9 | author: twesterhout
10 | maintainer: 14264576+twesterhout@users.noreply.github.com
11 | build-type: Simple
12 |
13 | -- extra-doc-files: CHANGELOG.md
14 | -- extra-source-files:
15 |
16 | common warnings
17 | ghc-options: -Wall
18 |
19 | library
20 | import: warnings
21 | exposed-modules: Playground
22 | build-depends:
23 | , base >=4.16.4.0 && <5
24 | , halide-haskell >=0.0.2 && <0.1
25 |
26 | hs-source-dirs: src
27 | default-language: GHC2021
28 |
29 | test-suite halide-haskell-playground-test
30 | import: warnings
31 | default-language: GHC2021
32 | type: exitcode-stdio-1.0
33 | hs-source-dirs: test
34 | main-is: Main.hs
35 | build-depends:
36 | , base
37 | , halide-haskell
38 | , halide-haskell-playground
39 | , hspec
40 |
--------------------------------------------------------------------------------
/template/src/Playground.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DataKinds #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Playground (awesomeSequence) where
5 |
6 | import Language.Halide
7 |
8 | awesomeSequence :: IO (Ptr (HalideBuffer 1 Int32) -> IO ())
9 | awesomeSequence = do
10 | i <- mkVar "i"
11 | compile $ do
12 | define "sequence" i (i * i)
13 |
--------------------------------------------------------------------------------
/template/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Language.Halide
4 | import Playground
5 | import Test.Hspec
6 |
7 | main :: IO ()
8 | main = hspec $ do
9 | describe "awesomeSequence" $ do
10 | it "compiles the kernel & generates a sequence" $ do
11 | kernel <- awesomeSequence
12 | allocaCpuBuffer [10] $ \buf -> do
13 | kernel buf
14 | peekToList buf `shouldReturn` [x * x | x <- [0 .. 9]]
15 |
--------------------------------------------------------------------------------
/test-readme/LICENSE:
--------------------------------------------------------------------------------
1 | ../LICENSE
--------------------------------------------------------------------------------
/test-readme/README.lhs:
--------------------------------------------------------------------------------
1 |
2 | halide-haskell
3 |
4 |
5 |
6 |
7 |

This project is still under heavy development and might not be production-ready

8 | We encourage experimenting with it and reporting any issues you run into via
9 | [Github issues](https://github.com/twesterhout/halide-haskell/issues).
10 |
11 |
12 |
13 | [**Tutorials**](https://github.com/twesterhout/halide-haskell/tree/master/tutorials) | [**Documentation**](https://hackage.haskell.org/package/halide-haskell-0.0.1.0) | [**Showcases**](https://github.com/twesterhout/halide-haskell-examples)
14 |
15 | [](LICENSE)
16 | [](https://github.com/twesterhout/halide-haskell/actions/workflows/ci.yml)
17 | [](https://hackage.haskell.org/package/halide-haskell)
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 | [Halide](https://halide-lang.org/) is a programming language designed to make
26 | it easier to write high-performance image and array processing code on modern
27 | machines. Rather than being a standalone programming language, Halide is
28 | embedded in C++. This means you write C++ code that builds an in-memory
29 | representation of a Halide pipeline using Halide's C++ API. You can then
30 | compile this representation to an object file, or JIT-compile it and run it in
31 | the same process.
32 |
33 | |
34 |
35 |
36 |
37 |
38 | This package provides Haskell bindings that allow to write Halide embedded in
39 | Haskell without C++ 😋.
40 |
41 |
42 | - [Example usage](#-example-usage)
43 | - [Installing](#-installing)
44 | - [Motivation](#-motivation)
45 | - [Contributing](#-contributing)
46 |
47 |
48 | ## 🚀 Example usage
49 |
50 | As a simple example, here's how you could implement array addition with halide-haskell:
51 |
52 | ```haskell
53 | {-# LANGUAGE AllowAmbiguousTypes, DataKinds, OverloadedStrings, ViewPatterns #-}
54 | import Language.Halide
55 |
56 | -- The algorithm
57 | mkArrayPlus = compile $ \(buffer "a" -> a) (buffer "b" -> b) -> do
58 | -- Create an index variable
59 | i <- mkVar "i"
60 | -- Define the resulting function. We call it "out".
61 | -- In pseudocode it's equivalent to the following: out[i] = a[i] + b[i]
62 | out <- define "out" i $ a ! i + b ! i
63 | -- Perform a fancy optimization and use SIMD: we split the loop over i into
64 | -- an inner and an outer loop and then vectorize the inner loop
65 | inner <- mkVar "inner"
66 | split TailAuto i (i, inner) 4 out >>= vectorize inner
67 |
68 | -- Example usage of our Halide pipeline
69 | main :: IO ()
70 | main = do
71 | let a, b :: [Float]
72 | a = [1, 2, 3, 4, 5]
73 | b = [6, 7, 8, 9, 10]
74 | -- Compile the code
75 | arrayPlus <- mkArrayPlus
76 | -- We tell Halide to treat our list as a one-dimensional buffer
77 | withHalideBuffer @1 @Float a $ \a' ->
78 | withHalideBuffer b $ \b' ->
79 | -- allocate a temporary buffer for the output
80 | allocaCpuBuffer [length a] $ \out' -> do
81 | -- execute the kernel -- it is a normal function call!
82 | arrayPlus a' b' out'
83 | -- print the result
84 | print =<< peekToList out'
85 | ```
86 |
87 | For more examples, have a look at the [tutorials](https://github.com/twesterhout/halide-haskell/tree/master/tutorials).
88 |
89 | ## 💻 Installing
90 |
91 | The library is avaiable on Hackage, so you can just add `halide-haskell` to the
92 | `build-depends` field in your Cabal file. However, halide-haskell depends on Halide,
93 | so you need to make sure it's available.
94 |
95 | ### ❄️ Nix
96 |
97 | No need to do anything 😃, Nix will make Halide avaiable automatically.
98 |
99 | If you just want to hack on the library, after `git clone`ing, type
100 |
101 | ```sh
102 | nix build
103 | ```
104 |
105 | and to run an example, try
106 |
107 | ```sh
108 | nix run
109 | nix run .#ghc928-intel-ocl.halide-haskell # for Intel OpenCL support
110 | nix run .#ghc928-cuda.halide-haskell # for CUDA support
111 | nix run .#ghc945.halide-haskell # to build with GHC 9.4.5 instead
112 | nix run .#ghc945.halide-tutorial01 # to run the first tutorial
113 | ```
114 |
115 | ### non-Nix
116 |
117 | This set up is not tested in CI... but
118 |
119 | - Download a pre-built Halide for your system from [their releases page](https://github.com/halide/Halide/releases/).
120 | - Pass `--extra-include-dirs` and `--extra-lib-dirs` options to Cabal on the command line or add them to your `cabal.project.local` file.
121 |
122 | ## 🤩 Motivation
123 |
124 | The availability of Deep Learning frameworks such as
125 | [PyTorch](https://pytorch.org/) or [JAX](https://github.com/google/jax) has
126 | revolutionized array processing, independently of whether one works on Machine
127 | Learning tasks or other numerical algorithms. The ecosystem in Haskell has been
128 | catching up as well, and there are now multiple good array
129 | libraries ([hmatrix](https://github.com/haskell-numerics/hmatrix),
130 | [massiv](https://github.com/lehins/massiv),
131 | [Accelerate](https://www.acceleratehs.org/),
132 | [arrayfire-haskell](https://github.com/arrayfire/arrayfire-haskell),
133 | [Hasktorch](https://github.com/hasktorch/hasktorch), are all high-quality
134 | libraries). To accommodate multiple domains, such libraries
135 | have to support hundreds if not thousands of operations (e.g. there are more
136 | than 3.5 thousand of so called [“native” functions in PyTorch](https://github.com/pytorch/pytorch/blob/6a09847c42bf7d33ba0aea5b083eebd846661ce1/aten/src/ATen/native/native_functions.yaml)),
137 | and this count does not include specializations for different device and data
138 | types).
139 |
140 | To overcome this difficulty, we propose to build a common extension mechanism
141 | for Haskell array libraries. The mechanism is based on embedding the
142 | [Halide](https://halide-lang.org/) language into Haskell that allows to
143 | just-in-time (JIT) compile computational kernels for various hardware.
144 |
145 | ### 🤨 Why not Accelerate?
146 |
147 | One might wonder, why write another package instead of relying on
148 | [Accelerate](https://www.acceleratehs.org/) for the JIT compilation of the
149 | kernels. Accelerate is a Haskell eDSL (embedded Domain Specific Language) for
150 | collective operations on dense multi-dimensional arrays. It relies on
151 | [LLVM](https://llvm.org/) to JIT compile the computational kernels for the
152 | target architecture including multicore CPUs and GPUs. Users have to rely on
153 | Accelerate to generate high-performance kernels and have no way to force some
154 | low-level optimizations. For example, [Trevor L. McDonell et
155 | al.](https://doi.org/10.1145/2887747.2804313) explain that the reason why
156 | hand-written [CUDA](https://www.nvidia.com/en-gb/geforce/technologies/cuda/)
157 | implementation of the [N-body
158 | problem](https://en.wikipedia.org/wiki/N-body_problem) outperforms Accelerate
159 | is the use of on-chip shared memory. Another example would be the matrix-matrix
160 | product where achieving maximal performance requires writing no fewer than six
161 | nested loops instead of the naive three ([ACM Trans. Math. Softw. 34, 3,
162 | Article 12 (May 2008)](https://doi.org/10.1145/1356052.1356053)).
163 | Accelerate has no way of knowing that such optimizations have to be applied and
164 | cannot perform them automatically, and this is precisely the gap that we are
165 | trying to fill by embedding Halide into Haskell.
166 |
167 | Halide is a C++ eDSL for high-performance image and array processing. Its core
168 | idea is to decouple the *algorithm* (i.e. what is computed) from the *schedule*
169 | (i.e. where and when it is computed). The eDSL allows to quickly prototype and
170 | test the algorithm and then move on to the optimization. Optimizations such as
171 | fusion, tiling, parallelism and vectorization can be freely explored without
172 | the risk of breaking the original algorithm definition. Schedulers can also be
173 | generated automatically by [advanced optimization
174 | algorithms](https://halide-lang.org/papers/autoscheduler2019.html)
175 |
176 | Halide provides a lower level interface than Accelerate and thus does not aim
177 | to replace it. Instead, Halide can be used to extend Accelerate, and later on
178 | one might even think about using Halide as a backend for Accelerate.
179 |
180 | ## 🔨 Contributing
181 |
182 | Currently, the best way to get started is to use Nix:
183 |
184 | ```sh
185 | nix develop
186 | ```
187 |
188 | This will drop you into a shell with all the necessary tools to build the code
189 | such that you can do
190 |
191 | ```sh
192 | cabal build
193 | ```
194 |
195 | and
196 |
197 | ```sh
198 | cabal test
199 | ```
200 |
--------------------------------------------------------------------------------
/test-readme/halide-readme.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-readme
3 | version: 0.0.1.0
4 | license: BSD-3-Clause
5 | author: twesterhout
6 | maintainer: 14264576+twesterhout@users.noreply.github.com
7 | build-type: Simple
8 |
9 | common setup
10 | ghc-options: -W -pgmL markdown-unlit
11 | default-language: GHC2021
12 | build-depends: base >=4.16.0.0 && <5
13 | , vector
14 | , halide-haskell
15 |
16 | executable halide-readme
17 | import: setup
18 | main-is: README.lhs
19 | hs-source-dirs: .
20 |
21 | test-suite halide-readme-test
22 | import: setup
23 | main-is: README.lhs
24 | type: exitcode-stdio-1.0
25 |
--------------------------------------------------------------------------------
/test/Language/Halide/BoundaryConditionsSpec.hs:
--------------------------------------------------------------------------------
1 | module Language.Halide.BoundaryConditionsSpec (spec) where
2 |
3 | import Language.Halide
4 | import Test.Hspec
5 |
6 | spec :: Spec
7 | spec = do
8 | it "extends the domain by repeating the edges" $ do
9 | let mat :: [[Float]]
10 | mat = [[1, 2, 3], [4, 5, 6]]
11 | asBufferParam @2 @Float mat $ \mat' -> do
12 | [i, j] <- mapM mkVar ["i", "j"]
13 | extended <- repeatEdge mat'
14 | f <- define "f" (i, j) $ extended ! (i - 1, j - 1)
15 | realize f [4, 5] peekToList
16 | `shouldReturn` [[1, 1, 2, 3, 3], [1, 1, 2, 3, 3], [4, 4, 5, 6, 6], [4, 4, 5, 6, 6]]
17 | it "extends the domain by filling with a constant value" $ do
18 | let mat :: [[Float]]
19 | mat = [[1, 2, 3], [4, 5, 6]]
20 | asBufferParam @2 @Float mat $ \mat' -> do
21 | [i, j] <- mapM mkVar ["i", "j"]
22 | extended <- constantExterior 0 mat'
23 | f <- define "f" (i, j) $ extended ! (i - 1, j - 1)
24 | realize f [4, 5] peekToList
25 | `shouldReturn` [[0, 0, 0, 0, 0], [0, 1, 2, 3, 0], [0, 4, 5, 6, 0], [0, 0, 0, 0, 0]]
26 |
--------------------------------------------------------------------------------
/test/Language/Halide/BufferSpec.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedRecordDot #-}
2 |
3 | module Language.Halide.BufferSpec (spec) where
4 |
5 | import Data.Int (Int64)
6 | import Foreign.Ptr (nullPtr)
7 | import Language.Halide
8 | import Test.Hspec
9 | import Test.Hspec.QuickCheck
10 | import Test.QuickCheck
11 |
12 | newtype ListVector a = ListVector [a]
13 | deriving stock (Show)
14 |
15 | newtype ListMatrix a = ListMatrix [[a]]
16 | deriving stock (Show)
17 |
18 | newtype ListTensor3D a = ListTensor3D [[[a]]]
19 | deriving stock (Show)
20 |
21 | newtype ListTensor4D a = ListTensor4D [[[[a]]]]
22 | deriving stock (Show)
23 |
24 | instance Arbitrary a => Arbitrary (ListVector a) where
25 | arbitrary = ListVector <$> listOf arbitrary
26 |
27 | instance Arbitrary a => Arbitrary (ListMatrix a) where
28 | arbitrary = do
29 | d0 <- chooseInt (0, 50)
30 | d1 <- chooseInt (0, 50)
31 | ListMatrix <$> vectorOf d0 (vector d1)
32 |
33 | instance Arbitrary a => Arbitrary (ListTensor3D a) where
34 | arbitrary = do
35 | d0 <- chooseInt (0, 30)
36 | d1 <- chooseInt (0, 30)
37 | d2 <- chooseInt (0, 30)
38 | ListTensor3D <$> vectorOf d0 (vectorOf d1 (vector d2))
39 |
40 | instance Arbitrary a => Arbitrary (ListTensor4D a) where
41 | arbitrary = do
42 | d0 <- chooseInt (0, 30)
43 | d1 <- chooseInt (0, 30)
44 | d2 <- chooseInt (0, 30)
45 | d3 <- chooseInt (0, 30)
46 | ListTensor4D <$> vectorOf d0 (vectorOf d1 (vectorOf d2 (vector d3)))
47 |
48 | spec :: Spec
49 | spec = do
50 | it "rowMajorStrides" $ do
51 | rowMajorStrides [1, 1, 1] `shouldBe` ([1, 1, 1] :: [Int])
52 | rowMajorStrides [2, 1, 3] `shouldBe` ([3, 3, 1] :: [Int])
53 | rowMajorStrides [3, 2] `shouldBe` ([2, 1] :: [Int])
54 | rowMajorStrides [] `shouldBe` ([] :: [Int])
55 | it "bufferFromPtrShapeStrides" $ do
56 | bufferFromPtrShapeStrides nullPtr [3, 2, 1] [1, 1, 1] (\(_ :: Ptr (HalideBuffer 2 Int32)) -> pure ())
57 | `shouldThrow` anyErrorCall
58 | bufferFromPtrShapeStrides nullPtr [3] [1] (\(_ :: Ptr (HalideBuffer 2 Int32)) -> pure ())
59 | `shouldThrow` anyErrorCall
60 | prop "works with [a]" $ \(ListVector xs :: ListVector Float) ->
61 | withHalideBuffer @1 @Float xs peekToList `shouldReturn` xs
62 | prop "works with [[a]]" $ \(ListMatrix xs :: ListMatrix Int64) ->
63 | withHalideBuffer @2 @Int64 xs peekToList `shouldReturn` xs
64 | prop "works with [[[a]]]" $ \(ListTensor3D xs :: ListTensor3D Double) ->
65 | withHalideBuffer @3 @Double xs peekToList `shouldReturn` xs
66 | modifyMaxSuccess (const 20) $
67 | prop "works with [[[[a]]]]" $ \(ListTensor4D @Double xs) ->
68 | withHalideBuffer @4 @Double xs peekToList `shouldReturn` xs
69 | it "creates cropped buffers" $ do
70 | let mkFill2D (scalar @Float "value" -> value) = do
71 | [i, j] <- mapM mkVar ["i", "j"]
72 | define "fill" (i, j) value
73 | fill <- compile mkFill2D
74 | allocaCpuBuffer [4, 4] $ \buf -> do
75 | fill 0 buf
76 | peekToList buf `shouldReturn` [[0, 0, 0, 0],
77 | [0, 0, 0, 0],
78 | [0, 0, 0, 0],
79 | [0, 0, 0, 0]]
80 | withCropped buf 1 0 1 $ fill 1
81 | peekToList buf `shouldReturn` [[1, 0, 0, 0],
82 | [1, 0, 0, 0],
83 | [1, 0, 0, 0],
84 | [1, 0, 0, 0]]
85 | withCropped buf 0 1 2 $ fill 2
86 | peekToList buf `shouldReturn` [[1, 0, 0, 0],
87 | [2, 2, 2, 2],
88 | [2, 2, 2, 2],
89 | [1, 0, 0, 0]]
90 |
--------------------------------------------------------------------------------
/test/Language/Halide/ExprSpec.hs:
--------------------------------------------------------------------------------
1 | module Language.Halide.ExprSpec (spec) where
2 |
3 | import Control.Monad (unless, when)
4 | import Data.Int
5 | import Data.Text (Text)
6 | import Data.Word
7 | import Language.Halide
8 | import Test.Hspec
9 | import Test.Hspec.QuickCheck
10 | import Test.QuickCheck
11 | import Type.Reflection
12 | import Utils
13 |
14 | isOverflowing :: Typeable a => (Integer -> Integer -> Integer) -> a -> a -> Bool
15 | isOverflowing op x y
16 | | Just HRefl <- eqTypeRep (typeOf x) (typeRep @Int32) =
17 | op (toInteger x) (toInteger y) > toInteger (maxBound @Int32)
18 | || op (toInteger x) (toInteger y) < toInteger (minBound @Int32)
19 | | Just HRefl <- eqTypeRep (typeOf x) (typeRep @Int64) =
20 | op (toInteger x) (toInteger y) > toInteger (maxBound @Int64)
21 | || op (toInteger x) (toInteger y) < toInteger (minBound @Int64)
22 | | otherwise = False
23 |
24 | -- infix 1 `evaluatesTo`
25 |
26 | -- evaluatesTo :: (Eq a, IsHalideType a) => Expr a -> a -> PropertyM IO ()
27 | -- evaluatesTo expr expected =
28 | -- assert . (expected ==) =<< (run . evaluate) expr
29 | --
30 |
31 | infix 1 `shouldEvaluateToApprox`
32 |
33 | shouldEvaluateToApprox :: (Ord a, IsHalideType a, HasEpsilon a, Show a) => Expr a -> a -> Expectation
34 | shouldEvaluateToApprox expr expected = do
35 | e <- evaluate expr
36 | e `shouldBeApprox` expected
37 |
38 | infix 1 `shouldEvaluateTo`
39 |
40 | shouldEvaluateTo :: (Eq a, IsHalideType a, Show a) => Expr a -> a -> Expectation
41 | shouldEvaluateTo expr expected = evaluate expr `shouldReturn` expected
42 |
43 | spec :: Spec
44 | spec = do
45 | describe "mkExpr" $ modifyMaxSuccess (const 10) $ do
46 | prop "Bool" $ \x ->
47 | mkExpr (x :: Bool) `shouldEvaluateTo` x
48 |
49 | describe "Num Expr" $ modifyMaxSuccess (const 10) $ do
50 | let whenNotOverflowing op x y check
51 | | isOverflowing op x y = pure ()
52 | | otherwise = check
53 | p :: forall a. (IsHalideType a, Eq a, Num a, Typeable a, Show a) => a -> a -> Expectation
54 | p x y = do
55 | whenNotOverflowing (+) x y $
56 | mkExpr x + mkExpr y `shouldEvaluateTo` x + y
57 | whenNotOverflowing (-) x y $
58 | mkExpr x - mkExpr y `shouldEvaluateTo` x - y
59 | whenNotOverflowing (*) x y $
60 | mkExpr x * mkExpr y `shouldEvaluateTo` x * y
61 | unless (x == -128) $
62 | abs (mkExpr x) `shouldEvaluateTo` abs x
63 | negate (mkExpr x) `shouldEvaluateTo` negate x
64 | prop "Int8" $ p @Int8
65 | prop "Int16" $ p @Int16
66 | prop "Int32" $ p @Int32
67 | prop "Int64" $ p @Int64
68 | prop "Word8" $ p @Word8
69 | prop "Word16" $ p @Word16
70 | prop "Word32" $ p @Word32
71 | prop "Word64" $ p @Word64
72 | prop "Float" $ p @Float
73 | prop "Double" $ p @Double
74 |
75 | describe "Fractional Expr" $ modifyMaxSuccess (const 10) $ do
76 | let p :: forall a. (IsHalideType a, Eq a, Fractional a, Show a) => a -> a -> Expectation
77 | p x y = do
78 | unless (x == 0 && y == 0) $
79 | mkExpr x / mkExpr y `shouldEvaluateTo` x / y
80 | prop "Float" $ property (p @Float)
81 | prop "Double" $ property (p @Double)
82 |
83 | describe "Floating Expr" $ modifyMaxSuccess (const 10) $ do
84 | let p :: forall a. (IsHalideType a, Ord a, Floating a, HasEpsilon a, Show a) => a -> Expectation
85 | p x = do
86 | let y = mkExpr x
87 | when (x > 0) $ do
88 | log y `shouldEvaluateToApprox` log x
89 | sqrt y `shouldEvaluateToApprox` sqrt x
90 | when (x < 50) $
91 | exp y `shouldEvaluateToApprox` exp x
92 | sin y `shouldEvaluateToApprox` sin x
93 | cos y `shouldEvaluateToApprox` cos x
94 | tan y `shouldEvaluateToApprox` tan x
95 | when (-1 <= x && x <= 1) $ do
96 | asin y `shouldEvaluateToApprox` asin x
97 | acos y `shouldEvaluateToApprox` acos x
98 | atan y `shouldEvaluateToApprox` atan x
99 | when (abs x < 50) $ do
100 | sinh y `shouldEvaluateToApprox` sinh x
101 | cosh y `shouldEvaluateToApprox` cosh x
102 | tanh y `shouldEvaluateToApprox` tanh x
103 | asinh y `shouldEvaluateToApprox` asinh x
104 | when (x >= 1) $
105 | acosh y `shouldEvaluateToApprox` acosh x
106 | when (-1 <= x && x <= 1) $
107 | atanh y `shouldEvaluateToApprox` atanh x
108 | prop "Float" $ p @Float
109 | prop "Double" $ p @Double
110 | it "defines pi" $ do
111 | (pi :: Expr Float) `shouldEvaluateToApprox` pi
112 | (pi :: Expr Double) `shouldEvaluateToApprox` pi
113 |
114 | describe "printed" $
115 | it "prints expressions when evaluated" $ do
116 | printed (1 :: Expr Int32) `shouldEvaluateTo` 1
117 | printed (1 :: Expr Int32) ("<- when" :: String) ("haha" :: String) `shouldEvaluateTo` 1
118 | let x :: Expr Float
119 | x = 1
120 | in printed (sin x) ("<- sin(" :: Text) x (")" :: Text) `shouldEvaluateToApprox` sin 1
121 |
122 | -- describe "Show" $
123 | -- it "shows 123" $ do
124 | -- show (123 :: Expr Int32) `shouldBe` "123"
125 | describe "testWriteToStderr" $ do
126 | it "shows 123" $ do
127 | testWriteToStderr
128 |
--------------------------------------------------------------------------------
/test/Language/Halide/FuncSpec.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedLists #-}
2 | {-# LANGUAGE OverloadedRecordDot #-}
3 | {-# LANGUAGE QuasiQuotes #-}
4 | {-# LANGUAGE TemplateHaskell #-}
5 | {-# LANGUAGE ViewPatterns #-}
6 |
7 | module Language.Halide.FuncSpec (spec) where
8 |
9 | import Control.Monad.ST (RealWorld)
10 | import Data.Vector.Storable.Mutable qualified as SM
11 | import Language.Halide
12 | import Test.Hspec hiding (parallel)
13 | import Utils
14 |
15 | importHalide
16 |
17 | data Matrix v a = Matrix
18 | { matrixRows :: !Int
19 | , matrixCols :: !Int
20 | , matrixData :: !(v a)
21 | }
22 | deriving stock (Show, Eq)
23 |
24 | instance IsHalideType a => IsHalideBuffer (Matrix (SM.MVector RealWorld) a) 2 a where
25 | withHalideBufferImpl (Matrix n m v) f =
26 | SM.unsafeWith v $ \dataPtr ->
27 | bufferFromPtrShapeStrides dataPtr [n, m] [1, n] f
28 |
29 | spec :: Spec
30 | spec = do
31 | describe "indexing" $ do
32 | it "supports empty tuples" $ do
33 | let x = mkExpr (5 :: Double)
34 | f <- define "f" () $ x * x - 2 * x + 5 + 3 / x
35 | g <- define "g" () $ f ! ()
36 | realize g [] peekScalar `shouldReturn` 20.6
37 |
38 | describe "vectorize" $ do
39 | it "vectorizes loops" $ do
40 | i <- mkVar "i"
41 | ii <- mkVar "inner"
42 | func <- define "func" i $ (3 * i + 1) * (i - 5)
43 | -- by default, nothing is vectorized
44 | prettyLoopNest func >>= \s -> do
45 | s `shouldNotContainText` "vectorized"
46 | s `shouldNotContainText` "[0, 3]"
47 |
48 | void $
49 | split TailShiftInwards i (i, ii) 4 func
50 | >>= vectorize ii
51 |
52 | -- now, the inner loop is vectorized
53 | prettyLoopNest func >>= \s -> do
54 | s `shouldContainText` "vectorized i.inner"
55 | s `shouldContainText` "in [0, 3]"
56 |
57 | let n = 10
58 | realize func [n] peekToList
59 | `shouldReturn` [(3 * k + 1) * (k - 5) | k <- [0 .. fromIntegral n - 1]]
60 |
61 | describe "unroll" $ do
62 | it "unrolls loops" $ do
63 | i <- mkVar "i"
64 | ii <- mkVar "inner"
65 | func <- define "func" i $ (3 * i + 1) * (i - 5)
66 | -- by default, nothing is unrolled
67 | prettyLoopNest func >>= \s -> do
68 | s `shouldNotContainText` "unrolled"
69 | s `shouldNotContainText` "[0, 2]"
70 |
71 | void $
72 | split TailGuardWithIf i (i, ii) 3 func
73 | >>= unroll ii
74 |
75 | -- now, the inner loop is unrolled
76 | prettyLoopNest func >>= \s -> do
77 | s `shouldContainText` "unrolled i.inner"
78 | s `shouldContainText` "in [0, 2]"
79 |
80 | let n = 17
81 | realize func [n] peekToList
82 | `shouldReturn` [(3 * k + 1) * (k - 5) | k <- [0 .. fromIntegral n - 1]]
83 |
84 | describe "reorder" $ do
85 | it "reorders loops" $ do
86 | x <- mkVar "x"
87 | y <- mkVar "y"
88 | z <- mkVar "z"
89 | func <- define "func" (x, y, z) $ x * (x + y) - 3 * z
90 |
91 | -- we have
92 | --
93 | -- for z
94 | -- for y
95 | -- for x
96 | prettyLoopNest func >>= \s -> do
97 | s & "for z" `appearsBeforeText` "for y"
98 | s & "for y" `appearsBeforeText` "for x"
99 |
100 | void $ reorder [z, x, y] func
101 |
102 | -- now we expect
103 | --
104 | -- for y
105 | -- for x
106 | -- for z
107 | prettyLoopNest func >>= \s -> do
108 | s & "for y" `appearsBeforeText` "for x"
109 | s & "for x" `appearsBeforeText` "for z"
110 |
111 | describe "split" $ do
112 | it "splits loops into sub-loops" $ do
113 | x <- mkVar "x"
114 | y <- mkVar "y"
115 | func <- define "func" (x, y) $ x * y
116 |
117 | -- we have
118 | --
119 | -- for y
120 | -- for x
121 | prettyLoopNest func >>= \s -> do
122 | s & "for y" `appearsBeforeText` "for x"
123 | s `shouldNotContainText` "outer"
124 | s `shouldNotContainText` "inner"
125 |
126 | outer <- mkVar "outer"
127 | inner <- mkVar "inner"
128 | void $ split TailGuardWithIf x (outer, inner) 7 func
129 |
130 | -- now we expect
131 | --
132 | -- for y
133 | -- for x.outer
134 | -- for x.inner
135 | prettyLoopNest func >>= \s -> do
136 | s & "for y" `appearsBeforeText` "for x.outer"
137 | s & "for x.outer" `appearsBeforeText` "for x.inner"
138 |
139 | describe "fuse" $ do
140 | it "merges sub-loops into one" $ do
141 | x <- mkVar "x"
142 | y <- mkVar "y"
143 | func <- define "func" (x, y) $ x * y
144 |
145 | -- we have
146 | --
147 | -- for y
148 | -- for x
149 | prettyLoopNest func >>= \s -> do
150 | s `shouldNotContainText` "common"
151 |
152 | common <- mkVar "common"
153 | void $ fuse (x, y) common func
154 |
155 | -- now we expect
156 | --
157 | -- for common
158 | prettyLoopNest func >>= \s -> do
159 | s `shouldNotContainText` "for x:"
160 | s `shouldNotContainText` "for y"
161 | s `shouldContainText` "for x.common"
162 |
163 | describe "parallel" $ do
164 | it "marks dimensions as parallel" $ do
165 | x <- mkVar "x"
166 | y <- mkVar "y"
167 | func <- define "func" (x, y) $ x * y
168 |
169 | prettyLoopNest func >>= \s ->
170 | s `shouldNotContainText` "parallel"
171 |
172 | void $
173 | parallel x func
174 | >>= serial y
175 |
176 | prettyLoopNest func >>= \s ->
177 | s `shouldContainText` "parallel x"
178 |
179 | describe "gpuBlocks" $ do
180 | it "marks dimensions as corresponding to GPU blocks" $ do
181 | do
182 | x <- mkVar "x"
183 | y <- mkVar "y"
184 | func <- define "func" (x, y) $ x * y
185 |
186 | prettyLoopNest func >>= \s -> do
187 | s `shouldNotContainText` "gpu_block"
188 | s `shouldNotContainText` "Default_GPU"
189 | void $ gpuBlocks DeviceDefaultGPU (x, y) func
190 | prettyLoopNest func >>= \s -> do
191 | s `shouldContainText` "gpu_block y"
192 | s `shouldContainText` "gpu_block x"
193 |
194 | do
195 | x <- mkVar "x"
196 | y <- mkVar "y"
197 | func <- define "func" (x, y) $ x * y
198 |
199 | prettyLoopNest func >>= \s -> do
200 | s `shouldNotContainText` "gpu_block"
201 | s `shouldNotContainText` "CUDA"
202 | void $ gpuBlocks DeviceCUDA y func
203 | prettyLoopNest func >>= \s -> do
204 | s `shouldContainText` "gpu_block y"
205 |
206 | describe "gpuThreads" $ do
207 | it "marks dimensions as corresponding to GPU threads" $ do
208 | do
209 | x <- mkVar "x"
210 | y <- mkVar "y"
211 | func <- define "func" (x, y) $ x * y
212 |
213 | prettyLoopNest func >>= \s -> do
214 | s `shouldNotContainText` "gpu_thread"
215 | s `shouldNotContainText` "Default_GPU"
216 | void $ gpuThreads DeviceDefaultGPU (x, y) func
217 | prettyLoopNest func >>= \s -> do
218 | s `shouldContainText` "gpu_thread y"
219 | s `shouldContainText` "gpu_thread x"
220 |
221 | do
222 | x <- mkVar "x"
223 | y <- mkVar "y"
224 | func <- define "func" (x, y) $ x * y
225 |
226 | prettyLoopNest func >>= \s -> do
227 | s `shouldNotContainText` "gpu_block"
228 | s `shouldNotContainText` "gpu_thread"
229 | s `shouldNotContainText` "CUDA"
230 | void $
231 | gpuBlocks DeviceCUDA y func
232 | >>= gpuThreads DeviceCUDA x
233 | prettyLoopNest func >>= \s -> do
234 | s `shouldContainText` "gpu_block y"
235 | s `shouldContainText` "gpu_thread x"
236 |
237 | describe "reductions" $ do
238 | it "computes reductions" $ do
239 | asBufferParam @1 @Int32 ([1, 2, 3, 4, 5] :: [Int32]) $ \src -> do
240 | n <- (.extent) <$> dim 0 src
241 | r <- mkRVar "r" 0 n
242 | i <- mkVar "i"
243 | f <- define "sum" i (mkExpr 0)
244 | update f (0 :: Expr Int32) $ f ! 0 + src ! r
245 | realize f [1] peekToList `shouldReturn` ([15] :: [Int32])
246 | it "computes multi-dimensional reductions" $ do
247 | asBufferParam @2 @Int32 ([[1, 2, 3], [4, 5, 6]] :: [[Int32]]) $ \src -> do
248 | d0 <- (.extent) <$> dim 0 src
249 | d1 <- (.extent) <$> dim 1 src
250 | r <- toRVars =<< mkRDom "r" (0, 0) (d0, d1)
251 | f <- define "sum" () (mkExpr 0)
252 | update f () $ f ! () + src ! r
253 | realize f [] peekScalar `shouldReturn` (21 :: Int32)
254 |
255 | describe "undef" $ do
256 | it "allows to skip stores" $ do
257 | i <- mkVar "i"
258 | f <- define "f" i $ ifThenElse (i `gt` 5) i 0
259 | update f i $ ifThenElse ((f ! i) `eq` 0) (2 * i) undef
260 | realize f [10] peekToList `shouldReturn` ([0, 2, 4, 6, 8, 10] <> [6 .. 9] :: [Int32])
261 |
262 | describe "Tuples" $ do
263 | it "defines tuple Funcs" $ do
264 | i <- mkVar "i"
265 | f <- define "f" i (i, i)
266 | _ <- computeRoot f
267 | g <- define "g" i $ fst (f ! i)
268 | _ <- computeRoot g
269 | realize g [5] peekToList `shouldReturn` [0 .. 4]
270 | pure ()
271 | it "compiles tuple Funcs" $ do
272 | kernel <- compile $ do
273 | i <- mkVar "i"
274 | define "f" i (i, i + 1)
275 |
276 | allocaCpuBuffer [5] $ \a ->
277 | allocaCpuBuffer [5] $ \b -> do
278 | kernel a b
279 | peekToList a `shouldReturn` [0 .. 4]
280 | peekToList b `shouldReturn` [1 .. 5]
281 |
--------------------------------------------------------------------------------
/test/Language/Halide/KernelSpec.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE PolyKinds #-}
2 | {-# LANGUAGE ViewPatterns #-}
3 |
4 | module Language.Halide.KernelSpec (spec) where
5 |
6 | import Language.Halide
7 | import Test.Hspec
8 | import Utils
9 |
10 | spec :: Spec
11 | spec = do
12 | describe "compile" $ do
13 | it "compiles a kernel that adds two vectors together" $ do
14 | vectorPlus <- compile $ \a b -> do
15 | i <- mkVar "i"
16 | define "out" i $ (a ! i :: Expr Float) + b ! i
17 | let n = 10
18 | a = replicate 10 (1 :: Float)
19 | b = replicate 10 (2 :: Float)
20 | withHalideBuffer @1 @Float a $ \a' ->
21 | withHalideBuffer @_ @Float b $ \b' ->
22 | allocaCpuBuffer @_ @Float [n] $ \out' -> do
23 | vectorPlus a' b' out'
24 | peekToList out' `shouldReturn` zipWith (+) a b
25 |
26 | it "compiles a kernel that generates a scaled diagonal matrix declaratively" $ do
27 | scaledDiagonal <- compile $ \(scale :: Expr Double) v -> do
28 | i <- mkVar "i"
29 | j <- mkVar "j"
30 | define "out" (i, j) $
31 | ifThenElse (i `eq` j) (v ! i / scale) 0
32 | let a :: [Double]
33 | a = [1.0, 2.0, 3.0]
34 | withHalideBuffer a $ \a' ->
35 | allocaCpuBuffer [3, 3] $ \out' -> do
36 | scaledDiagonal 2 a' out'
37 | peekToList out' `shouldReturn` [[0.5, 0, 0], [0, 1, 0], [0, 0, 1.5]]
38 |
39 | it "compiles a kernel that generates a scaled diagonal matrix statefully" $ do
40 | scaledDiagonal <- compile $ \(scale :: Expr Double) v -> do
41 | i <- mkVar "i"
42 | j <- mkVar "j"
43 | out <- define "out" (i, j) (mkExpr 0)
44 | update out (i, i) (v ! i / scale)
45 | pure out
46 | let a :: [Double]
47 | a = [1.0, 2.0, 3.0]
48 | withHalideBuffer a $ \a' ->
49 | allocaCpuBuffer [3, 3] $ \out' -> do
50 | scaledDiagonal 2 a' out'
51 | peekToList out' `shouldReturn` [[0.5, 0, 0], [0, 1, 0], [0, 0, 1.5]]
52 |
53 | describe "compileToLoweredStmt" $ do
54 | it "compiles to lowered stmt file" $ do
55 | let builder (buffer "src" -> src) (scalar @Float "c" -> c) = do
56 | i <- mkVar "i"
57 | define "dest1234" i $ c * src ! i
58 | target =
59 | setFeature FeatureNoAsserts . setFeature FeatureNoBoundsQuery $
60 | hostTarget
61 | s <- compileToLoweredStmt StmtText target builder
62 | s `shouldContainText` "func dest1234 (src, c, dest1234) {"
63 | s `shouldContainText` "produce dest1234 {"
64 |
--------------------------------------------------------------------------------
/test/Language/Halide/LoopLevelSpec.hs:
--------------------------------------------------------------------------------
1 | -- {-# LANGUAGE OverloadedLists #-}
2 | {-# LANGUAGE QuasiQuotes #-}
3 | {-# LANGUAGE TemplateHaskell #-}
4 | {-# LANGUAGE ViewPatterns #-}
5 |
6 | module Language.Halide.LoopLevelSpec (spec) where
7 |
8 | -- import Control.Exception (catch)
9 | -- import Control.Monad (void)
10 | -- import Control.Monad.ST (RealWorld)
11 | -- import Data.Function ((&))
12 | -- import Data.Int
13 | -- import Data.Text (Text)
14 | -- import qualified Data.Text as T
15 | -- import qualified Data.Text.Encoding as T
16 | -- import qualified Data.Text.IO as T
17 | -- import qualified Data.Vector.Storable as S
18 | -- import qualified Data.Vector.Storable.Mutable as SM
19 | -- import qualified Language.C.Inline.Cpp.Exception as C
20 | -- import qualified Language.C.Inline.Unsafe as CU
21 | -- import Language.Halide.Context
22 | -- import Language.Halide.LoopLevel
23 | import Language.Halide
24 | import Test.Hspec
25 |
26 | importHalide
27 |
28 | spec :: Spec
29 | spec = do
30 | pure ()
31 |
32 | -- describe "computeAt" $ do
33 | -- it "schedules the computation to happen at a particular loop level" $ do
34 | -- let innerLoop = do
35 | -- x <- mkVar "x"
36 | -- y <- mkVar "y"
37 | -- g <- define "g" (x, y) $ x * y
38 | -- -- f <- define "f" (x, y) $ g ! (x, y) + g ! (x, y + 1) + g ! (x + 1, y) + g ! (x + 1, y + 1)
39 | -- f <-
40 | -- define "f" (x, y) $
41 | -- sum $
42 | -- (g !) <$> [(x, y), (x, y + 1), (x + 1, y), (x + 1, y + 1)]
43 | -- -- T.putStrLn =<< prettyLoopNest f
44 | -- computeAt g =<< getLoopLevel f x
45 | -- s <- prettyLoopNest f
46 | -- s `shouldContainText` "produce g"
47 | -- s `shouldContainText` "consume g"
48 | -- -- T.putStrLn s
49 | -- -- Both loops should appear before the produce statement
50 | -- s & "for y" `appearsBeforeText` "produce g"
51 | -- s & "for x" `appearsBeforeText` "produce g"
52 | -- outerLoop = do
53 | -- x <- mkVar "x"
54 | -- y <- mkVar "y"
55 | -- g <- define "g" (x, y) $ x * y
56 | -- -- f <- define "f" (x, y) $ g ! (x, y) + g ! (x, y + 1) + g ! (x + 1, y) + g ! (x + 1, y + 1)
57 | -- f <-
58 | -- define "f" (x, y) $
59 | -- sum $
60 | -- (g !) <$> [(x, y), (x, y + 1), (x + 1, y), (x + 1, y + 1)]
61 | -- computeAt g =<< getLoopLevel f y
62 | -- s <- prettyLoopNest f
63 | -- -- The produce statement should appear between for y and for x
64 | -- s & "for y" `appearsBeforeText` "produce g"
65 | -- s & "produce g" `appearsBeforeText` "for x"
66 | -- innerLoop
67 | -- outerLoop
68 |
69 | -- describe "computeWith" $ do
70 | -- it "schedules outer loops to be fused with another computation" $ do
71 | -- x <- mkVar "x"
72 | -- y <- mkVar "y"
73 | -- f <- define "f" (x, y) $ x + y
74 | -- g <- define "g" (x, y) $ x - y
75 | -- h <- define "h" (x, y) $ f ! (x, y) + g ! (x, y)
76 | -- computeRoot f
77 | -- computeRoot g
78 | -- xi <- mkVar "xi"
79 | -- xo <- mkVar "xo"
80 | -- split TailAuto f x xo xi 8
81 | -- split TailAuto g x xo xi 8
82 |
83 | -- prettyLoopNest h >>= \s -> do
84 | -- s `shouldContainText` "for x.xo"
85 | -- s `shouldContainText` "for x.xi"
86 | -- s `shouldNotContainText` "fused"
87 |
88 | -- computeWith LoopAlignAuto g =<< getLoopLevelAtStage f xo 0
89 |
90 | -- prettyLoopNest h >>= \s -> do
91 | -- s `shouldContainText` "for x.xi"
92 | -- s `shouldContainText` "for fused.y"
93 | -- s `shouldContainText` "for x.fused.xo"
94 |
95 | -- describe "storeAt" $ do
96 | -- it "allocates storage at a particular loop level" $ do
97 | -- -- [C.throwBlock| void {
98 | -- -- using namespace Halide;
99 | -- -- Func f, g;
100 | -- -- Var x, y;
101 | -- -- g(x, y) = x*y;
102 | -- -- f(x, y) = g(x, y) + g(x, y+1) + g(x+1, y) + g(x+1, y+1);
103 | -- -- g.compute_at(f, x);
104 |
105 | -- -- f.print_loop_nest();
106 | -- -- } |]
107 |
108 | -- x <- mkVar "x"
109 | -- y <- mkVar "y"
110 | -- g <- define "g" (x, y) $ x * y
111 | -- f <- define "f" (x, y) $ g ! (x, y) + g ! (x, y + 1) + g ! (x + 1, y) + g ! (x + 1, y + 1)
112 | -- computeAt g =<< getLoopLevel f x
113 | -- T.putStrLn =<< prettyLoopNest f
114 | -- storeAt g =<< getLoopLevel f y
115 | -- T.putStrLn =<< prettyLoopNest f
116 | -- s <- prettyLoopNest f
117 | -- (pure (<) <*> (startIdxOf s "for y") <*> (startIdxOf s "store g"))
118 | -- `shouldBe` Just True
119 | -- (pure (>) <*> (startIdxOf s "for x") <*> (startIdxOf s "store g"))
120 | -- `shouldBe` Just True
121 |
--------------------------------------------------------------------------------
/test/Language/Halide/ScheduleSpec.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedRecordDot #-}
2 |
3 | module Language.Halide.ScheduleSpec (spec) where
4 |
5 | import Control.Monad (forM_)
6 | import Data.Text.IO qualified as T
7 | import GHC.TypeLits
8 | import Language.Halide
9 | import Test.Hspec
10 | import Test.Hspec.QuickCheck
11 | import Utils
12 |
13 | checkScheduleRoundTrip :: (KnownNat n, IsHalideType a) => IO (Func t n (Expr a)) -> (Func t n (Expr a) -> IO ()) -> Expectation
14 | checkScheduleRoundTrip prepare schedule = do
15 | f1 <- prepare
16 | f2 <- prepare
17 |
18 | schedule f1
19 | s1 <- getStageSchedule =<< getStage f1
20 | l1 <- prettyLoopNest f1
21 |
22 | applySchedule s1 =<< getStage f2
23 | s2 <- getStageSchedule =<< getStage f2
24 | l2 <- prettyLoopNest f2
25 |
26 | l1 `shouldBe` l2
27 | s1 `shouldBeEqForTesting` s2
28 |
29 | spec :: Spec
30 | spec = do
31 | describe "Extracts schedules" $ do
32 | it "supports vectorize" $ do
33 | [x, y, z] <- mapM mkVar ["x", "y", "z"]
34 | xInner <- mkVar "xInner"
35 | f <- define "f" (x, y, z) $ sin (cast @Float (x * y * z))
36 | void $
37 | split TailAuto x (x, xInner) 2 f
38 | >>= vectorize xInner
39 | schedule <- getStageSchedule =<< getStage f
40 | head schedule.dims `shouldBe` Dim "x.xInner" ForVectorized DeviceNone DimPureVar
41 |
42 | it "supports fuse" $ do
43 | [x, y, z] <- mapM mkVar ["x", "y", "z"]
44 | k <- mkVar "k"
45 | f <- define "f" (x, y, z) $ sin (cast @Float (x * y * z))
46 | void $ fuse (y, z) k f
47 | schedule <- getStageSchedule =<< getStage f
48 | print schedule
49 |
50 | describe "Applies schedules" $ do
51 | it "supports split" $ do
52 | let prepare = do
53 | [x, y, z] <- mapM mkVar ["x", "y", "z"]
54 | define "f" (x, y, z) $ sin (cast @Float (x * y * z))
55 | schedule f = do
56 | [x, _, _] <- getArgs f
57 | xInner <- mkVar "xInner"
58 | void $ split TailAuto x (x, xInner) 2 f
59 | checkScheduleRoundTrip prepare schedule
60 | it "supports fuse" $ do
61 | -- pendingWith "fails for unknown reason"
62 | let prepare = do
63 | [x, y, z] <- mapM mkVar ["x", "y", "z"]
64 | define "f" (x, y, z) $ sin (cast @Float (x * y * z))
65 | schedule f = do
66 | [_, y, z] <- getArgs f
67 | k <- mkVar "k"
68 | void $ fuse (y, z) k f
69 | checkScheduleRoundTrip prepare schedule
70 | it "supports vectorize" $ do
71 | -- pendingWith "fails for unknown reason"
72 | let prepare = do
73 | [x, y, z] <- mapM mkVar ["x", "y", "z"]
74 | define "f" (x, y, z) $ sin (cast @Float (x * y * z))
75 | schedule f = do
76 | [x, _, _] <- getArgs f
77 | xOuter <- mkVar "xOuter"
78 | xInnerOuter <- mkVar "xInnerOuter"
79 | xInnerInner <- mkVar "xInnerInner"
80 | void $
81 | split TailAuto x (x, xOuter) 4 f
82 | >>= split TailAuto xOuter (xInnerOuter, xInnerInner) 2
83 | >>= vectorize xInnerInner
84 | checkScheduleRoundTrip prepare schedule
85 | it "supports computeWith" $ do
86 | -- pendingWith "fails for unknown reason"
87 | let prepare = do
88 | x <- mkVar "x"
89 | y <- mkVar "y"
90 | f <- define "f" (x, y) $ x + y
91 | g <- define "g" (x, y) $ x - y
92 | h <- define "h" (x, y) $ f ! (x, y) + g ! (x, y)
93 | estimate x 0 200 h
94 | estimate y 0 200 h
95 | pure h
96 | let schedule h = do
97 | loadAutoScheduler Adams2019
98 | T.putStrLn =<< applyAutoScheduler Adams2019 hostTarget h
99 | checkScheduleRoundTrip prepare schedule
100 |
101 | -- [x, _, _] <- getArgs f
102 | -- xOuter <- mkVar "xOuter"
103 | -- xInnerOuter <- mkVar "xInnerOuter"
104 | -- xInnerInner <- mkVar "xInnerInner"
105 | -- void $
106 | -- split TailAuto x (x, xOuter) 4 f
107 | -- >>= split TailAuto xOuter (xInnerOuter, xInnerInner) 2
108 | -- >>= vectorize xInnerInner
109 | -- computeRoot f
110 | -- computeRoot g
111 | -- computeRoot k
112 | -- xi <- mkVar "xi"
113 | -- xo <- mkVar "xo"
114 | -- split TailAuto x (xo, xi) 8 f
115 | -- split TailAuto x (xo, xi) 8 g
116 | -- split TailAuto x (xo, xi) 8 k
117 | -- l <- getLoopLevelAtStage f xo 0
118 | -- print l
119 | -- computeWith LoopAlignAuto g l
120 | -- computeWith LoopAlignAuto f =<< getLoopLevelAtStage k xo 0
121 |
122 | prop "supports autoschedulers" $ do
123 | -- pendingWith "fails for unknown reason"
124 | let prepare1 = do
125 | [x, y] <- mapM mkVar ["x", "y"]
126 | f <- define "f" (x, y) $ x * y
127 | estimate x 0 100 f
128 | estimate y 0 100 f
129 | pure f
130 | let prepare2 = do
131 | x <- mkVar "x"
132 | y <- mkVar "y"
133 | f <- define "f" (x, y) $ x + y
134 | g <- define "g" (x, y) $ x - y
135 | h <- define "h" (x, y) $ f ! (x, y) + g ! (x, y)
136 | estimate x 0 200 h
137 | estimate y 0 200 h
138 | pure h
139 | let schedule target (Just scheduler) f = do
140 | loadAutoScheduler scheduler
141 | void $ applyAutoScheduler scheduler target f
142 | schedule _ _ _ = pure ()
143 |
144 | forM_ [prepare1, prepare2] $ \prepare -> do
145 | checkScheduleRoundTrip prepare (schedule hostTarget Nothing)
146 | checkScheduleRoundTrip prepare (schedule hostTarget (Just Adams2019))
147 | checkScheduleRoundTrip prepare (schedule hostTarget (Just Li2018))
148 | checkScheduleRoundTrip prepare (schedule hostTarget (Just Mullapudi2016))
149 |
150 | it "supports scalar estimates" $ do
151 | let f scheduler (scalar @Float "c" -> c) = do
152 | [x, y] <- mapM mkVar ["x", "y"]
153 | f <- define "f" (x, y) c
154 | estimate x 0 100 f
155 | estimate y 0 100 f
156 | setScalarEstimate 5.0 c
157 | loadAutoScheduler scheduler
158 | void $ applyAutoScheduler scheduler hostTarget f
159 | pure f
160 | _ <- compile $ f Adams2019
161 | pure ()
162 |
163 | -- (x, y, z, xInner, f1) <- prepare
164 | -- split TailAuto x (x, xInner) 2 f1
165 | -- nest1 <- prettyLoopNest f1
166 | -- schedule1 <- getStageSchedule =<< getStage f1
167 | -- print schedule1
168 | -- (_, _, _, _, f2) <- prepare
169 | -- applySchedule schedule1 =<< getStage f2
170 | -- schedule2 <- getStageSchedule =<< getStage f2
171 | -- nest2 <- prettyLoopNest f2
172 | -- nest1 `shouldBe` nest2
173 | -- T.putStrLn nest2
174 | -- print schedule2
175 |
176 | {-
177 | describe "prints schedules" $ do
178 | it "of auto-scheduled pipelines" $ do
179 | let builder :: Bool -> Target -> Func 'ParamTy 1 Int64 -> IO (Func 'FuncTy 1 Float)
180 | builder useAutoScheduler target src = do
181 | i <- mkVar "i"
182 | dest <- define "dest1" i $ sin (cast @Float (src ! i))
183 | -- dim 0 src >>= setEstimate 0 1000
184 | -- dim 0 src >>= setMin 0 >>= setStride 1 >>= print
185 | -- schedule <- do
186 | estimate i 0 1000 dest
187 |
188 | when useAutoScheduler $ do
189 | loadAutoScheduler Adams2019
190 | T.putStrLn =<< applyAutoScheduler Adams2019 target dest
191 | print =<< getStageSchedule =<< getStage dest
192 | -- print =<< getStageSchedule =<< getStage dest
193 |
194 | -- T.putStrLn =<< prettyLoopNest dest
195 | -- T.putStrLn =<< prettyLoopNest clone
196 | -- schedule <- getStageSchedule dest
197 | -- print schedule.dims
198 | -- print =<< (getSplits <$> getStageSchedule dest)
199 | pure dest
200 | let target = hostTarget -- setFeature FeatureOpenCL hostTarget
201 | copy <- compileForTarget target (builder True target)
202 | -- let src :: S.Vector Int64
203 | -- src = S.generate 100 fromIntegral
204 | pure ()
205 | -}
206 | {-
207 | it "of computeWith" $ do
208 | x <- mkVar "x"
209 | y <- mkVar "y"
210 | f <- define "f" (x, y) $ x + y
211 | g <- define "g" (x, y) $ x - y
212 | k <- define "k" (x, y) $ x * y
213 | h <- define "h" (x, y) $ f ! (x, y) + g ! (x, y) + k ! (x, y)
214 | computeRoot f
215 | computeRoot g
216 | computeRoot k
217 | xi <- mkVar "xi"
218 | xo <- mkVar "xo"
219 | split TailAuto x (xo, xi) 8 f
220 | split TailAuto x (xo, xi) 8 g
221 | split TailAuto x (xo, xi) 8 k
222 | l <- getLoopLevelAtStage f xo 0
223 | print l
224 | computeWith LoopAlignAuto g l
225 | computeWith LoopAlignAuto f =<< getLoopLevelAtStage k xo 0
226 |
227 | hPutStrLn stderr =<< prettyLoopNest h
228 |
229 | schedule <- getStageSchedule =<< getStage g
230 | print schedule
231 | -}
232 |
233 | -- prettyLoopNest h >>= \s -> do
234 | -- s `shouldContainText` "for x.xi"
235 | -- s `shouldContainText` "for fused.y"
236 | -- s `shouldContainText` "for x.fused.xo"
237 |
238 | -- dest <- SM.new (S.length src)
239 | -- withHalideBuffer src $ \srcPtr ->
240 | -- withHalideBuffer dest $ \destPtr ->
241 | -- copy srcPtr destPtr
242 | -- S.unsafeFreeze dest `shouldReturn` src
243 |
--------------------------------------------------------------------------------
/test/Language/Halide/TargetSpec.hs:
--------------------------------------------------------------------------------
1 | module Language.Halide.TargetSpec (spec) where
2 |
3 | import Language.Halide
4 | import Test.Hspec
5 |
6 | spec :: Spec
7 | spec = do
8 | describe "setFeature" $ do
9 | it "adds features to JIT targets" $ do
10 | setFeature FeatureCUDA hostTarget `shouldSatisfy` hasGpuFeature
--------------------------------------------------------------------------------
/test/Spec.hs:
--------------------------------------------------------------------------------
1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--------------------------------------------------------------------------------
/test/Utils.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DefaultSignatures #-}
2 | {-# LANGUAGE OverloadedRecordDot #-}
3 | {-# LANGUAGE UndecidableInstances #-}
4 |
5 | module Utils
6 | ( shouldContainText
7 | , shouldNotContainText
8 | , appearsBeforeText
9 | , shouldBeApprox
10 | , shouldBeEqForTesting
11 | , testOnGpu
12 | , approx
13 | , approxWith
14 | , (&)
15 | , void
16 | , T.hPutStrLn
17 | , stderr
18 | , HasEpsilon
19 | , eps
20 | , showInCodeLenses
21 | , EqForTesting (..)
22 | )
23 | where
24 |
25 | import Control.Exception (throwIO)
26 | import Control.Monad (unless, void)
27 | import Data.Function ((&))
28 | import Data.Text (Text, unpack)
29 | import Data.Text qualified as T
30 | import Data.Text.IO qualified as T
31 | import GHC.Exts (IsList (..))
32 | import GHC.Stack
33 | import Language.Halide hiding (and, max)
34 | import System.IO (stderr)
35 | import Test.HUnit.Lang (FailureReason (..), HUnitFailure (..))
36 | import Test.Hspec
37 |
38 | shouldContainText :: Text -> Text -> Expectation
39 | a `shouldContainText` b = T.unpack a `shouldContain` T.unpack b
40 |
41 | shouldNotContainText :: Text -> Text -> Expectation
42 | a `shouldNotContainText` b = T.unpack a `shouldNotContain` T.unpack b
43 |
44 | appearsBeforeText :: Text -> Text -> Text -> Expectation
45 | appearsBeforeText a b t = do
46 | t `shouldContainText` b
47 | fst (T.breakOn b t) `shouldContainText` a
48 |
49 | testOnGpu :: (Target -> Expectation) -> Expectation
50 | testOnGpu f =
51 | case gpuTarget of
52 | Just t -> f t
53 | Nothing -> pendingWith "no GPU target available"
54 |
55 | compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> a -> a -> Expectation
56 | compareWith comparator result expected =
57 | unless (comparator result expected) $ do
58 | throwIO (HUnitFailure location $ ExpectedButGot Nothing expectedMsg actualMsg)
59 | where
60 | expectedMsg = show expected
61 | actualMsg = show result
62 | location = case reverse (toList callStack) of
63 | (_, loc) : _ -> Just loc
64 | [] -> Nothing
65 |
66 | class Num a => HasEpsilon a where
67 | eps :: a
68 |
69 | instance HasEpsilon Float where
70 | eps = 1.1920929e-7
71 |
72 | instance HasEpsilon Double where
73 | eps = 2.220446049250313e-16
74 |
75 | approxWith :: (Ord a, Num a) => a -> a -> a -> a -> Bool
76 | approxWith rtol atol a b = abs (a - b) <= max atol (rtol * max (abs a) (abs b))
77 |
78 | approx :: (Ord a, HasEpsilon a) => a -> a -> Bool
79 | approx a b = approxWith (2 * eps * max (abs a) (abs b)) (4 * eps) a b
80 |
81 | shouldBeApprox :: (Ord a, HasEpsilon a, Show a) => a -> a -> Expectation
82 | shouldBeApprox = compareWith approx
83 |
84 | shouldBeEqForTesting :: (HasCallStack, EqForTesting a, Show a) => a -> a -> Expectation
85 | shouldBeEqForTesting = compareWith equalForTesting
86 |
87 | showInCodeLenses :: Text -> IO String
88 | showInCodeLenses v = error (unpack v)
89 |
90 | class EqForTesting a where
91 | equalForTesting :: a -> a -> Bool
92 | default equalForTesting :: Eq a => a -> a -> Bool
93 | a `equalForTesting` b = a == b
94 |
95 | instance EqForTesting a => EqForTesting [a] where
96 | as `equalForTesting` bs = and $ zipWith equalForTesting as bs
97 |
98 | instance EqForTesting (Expr Int32) where
99 | a `equalForTesting` b
100 | | (Just aInt, Just bInt) <- (toIntImm a, toIntImm b) = aInt == bInt
101 | | otherwise = show a == show b
102 |
103 | instance EqForTesting SplitContents where
104 | a `equalForTesting` b =
105 | and
106 | [ a.splitOld == b.splitOld
107 | , a.splitOuter == b.splitOuter
108 | , a.splitInner == b.splitInner
109 | , a.splitFactor `equalForTesting` b.splitFactor
110 | , a.splitExact == b.splitExact
111 | , a.splitTail == b.splitTail
112 | ]
113 |
114 | instance EqForTesting Split where
115 | (SplitVar a) `equalForTesting` (SplitVar b) = a `equalForTesting` b
116 | (FuseVars a) `equalForTesting` (FuseVars b) = a == b
117 | _ `equalForTesting` _ = False
118 |
119 | instance EqForTesting ReductionVariable where
120 | a `equalForTesting` b = a.varName == b.varName && a.minExpr `equalForTesting` b.minExpr && a.extentExpr `equalForTesting` b.extentExpr
121 |
122 | instance EqForTesting PrefetchDirective where
123 | a `equalForTesting` b =
124 | and
125 | [ a.prefetchFunc == b.prefetchFunc
126 | , a.prefetchAt == b.prefetchAt
127 | , a.prefetchFrom == b.prefetchFrom
128 | , a.prefetchOffset `equalForTesting` b.prefetchOffset
129 | , a.prefetchStrategy == b.prefetchStrategy
130 | ]
131 |
132 | instance EqForTesting StageSchedule where
133 | a `equalForTesting` b =
134 | and
135 | [ a.rvars `equalForTesting` b.rvars
136 | , a.dims == b.dims
137 | , a.prefetches `equalForTesting` b.prefetches
138 | , a.fuseLevel == b.fuseLevel
139 | , a.fusedPairs == b.fusedPairs
140 | , a.allowRaceConditions == b.allowRaceConditions
141 | ]
142 |
--------------------------------------------------------------------------------
/test/exceptions.cpp:
--------------------------------------------------------------------------------
1 | #include
2 |
3 | int main() {
4 | std::cout << Halide::exceptions_enabled() << std::endl;
5 |
6 | try {
7 | Halide::Func f;
8 | Halide::Var i;
9 | f(i) = Halide::Expr{static_cast(2147483647)} +
10 | Halide::Expr{static_cast(10000)};
11 | Halide::Buffer b = f.realize({1});
12 | std::cout << "result: " << b(0) << std::endl;
13 | } catch (Halide::CompileError &e) {
14 | std::cout << "caught error: " << e.what() << std::endl;
15 | }
16 |
17 | try {
18 | Halide::Func f;
19 | Halide::Var i;
20 | f(i) = Halide::Expr{static_cast(2147483647)} +
21 | Halide::Expr{static_cast(10000)};
22 | Halide::Buffer b = f.realize({1});
23 | std::cout << "result: " << b(0) << std::endl;
24 | } catch (Halide::CompileError &e) {
25 | std::cout << "caught error: " << e.what() << std::endl;
26 | }
27 | }
--------------------------------------------------------------------------------
/test/write_to_ostream.cpp:
--------------------------------------------------------------------------------
1 | #include
2 | #include
3 |
4 | int main() {
5 | Halide::Expr expr{123};
6 | std::ostringstream out;
7 | out << expr;
8 | std::cerr << "Output: '" << out.str() << "'" << std::endl;
9 | }
10 |
--------------------------------------------------------------------------------
/tutorials/01-Basics/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2023, twesterhout
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of twesterhout nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 |
--------------------------------------------------------------------------------
/tutorials/01-Basics/README.lhs:
--------------------------------------------------------------------------------
1 | README.md
--------------------------------------------------------------------------------
/tutorials/01-Basics/README.md:
--------------------------------------------------------------------------------
1 | # Tutorial 1: Getting started with Funcs, Vars, and Exprs
2 |
3 | This lesson demonstrates basic usage of Halide as a JIT compiler for imaging.
4 |
5 | Because this README is also a literate Haskell file, we start with a few common imports.
6 |
7 | ```haskell
8 | {-# LANGUAGE OverloadedStrings, TypeApplications #-}
9 | import Test.Hspec
10 |
11 | import Language.Halide
12 | ```
13 |
14 | This program defines a single-stage imaging pipeline that outputs a grayscale diagonal gradient.
15 |
16 | `Var` objects are names to use as variables in the definition of a `Func`. They have no meaning by
17 | themselves. In the following, we define two `Var`s named "x" and "y". These names will be used
18 | internally by Halide during code generation.
19 |
20 | ```haskell
21 | main :: IO ()
22 | main = hspec $ specify "Tutorial 1" $ do
23 | x <- mkVar "x"
24 | y <- mkVar "y"
25 | ```
26 |
27 | A `Func` object represents a pipeline stage. It's a pure function that defines what value each pixel
28 | should have. You can think of it as a computed image.
29 |
30 | `Func`s are defined at any integer coordinate of its variables as an `Expr` in terms of those
31 | variables and other functions. Here, we'll define an `Expr` which has the value `x + y`.
32 |
33 | ```haskell
34 | let e :: Expr Int32
35 | e = x + y
36 | ```
37 |
38 | Now we'll add a definition for the `Func` object. At pixel `x`, `y`, the image will have the value of
39 | the `Expr` `e`.
40 |
41 | ```haskell
42 | gradient <- define "gradient" (x, y) e
43 | ```
44 |
45 | Now we realize the `Func`, which JIT compiles some code that implements the pipeline we've defined,
46 | and then runs it. We also need to tell Halide the domain over which to evaluate the `Func`, which
47 | determines the range of `x` and `y` above, and the resolution of the output image. Since there's
48 | no preferred multi-dimensional array data type in Haskell, Halide gives us a pointer to the
49 | internal buffer such that we can convert it to our data type of choice. Here, we simply cast it
50 | into a list `[[Int32]]` and compare the result against a simple list comprehension.
51 |
52 | ```haskell
53 | realize gradient [20, 10] $ \buf ->
54 | peekToList buf `shouldReturn` [[x' + y' | y' <- [0 .. 9]] | x' <- [0 .. 19]]
55 | ```
56 |
--------------------------------------------------------------------------------
/tutorials/01-Basics/halide-tutorial01.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-tutorial01
3 | version: 0.0.1.0
4 | license: BSD-3-Clause
5 | license-file: LICENSE
6 | author: twesterhout
7 | maintainer: 14264576+twesterhout@users.noreply.github.com
8 | build-type: Simple
9 |
10 | common setup
11 | ghc-options: -W -pgmL markdown-unlit
12 | default-language: GHC2021
13 | build-depends: base >=4.16.0.0 && <5
14 | , vector
15 | , halide-haskell
16 | , hspec
17 | -- build-tools-depends: markdown-unlit:exe:markdown-unlit
18 |
19 | executable halide-tutorial01
20 | import: setup
21 | main-is: README.lhs
22 | hs-source-dirs: .
23 |
24 | test-suite halide-tutorial01-test
25 | import: setup
26 | main-is: README.lhs
27 | type: exitcode-stdio-1.0
28 |
--------------------------------------------------------------------------------
/tutorials/03-Inspecting/README.lhs:
--------------------------------------------------------------------------------
1 | README.md
--------------------------------------------------------------------------------
/tutorials/03-Inspecting/README.md:
--------------------------------------------------------------------------------
1 | # Tutorial 3: Inspecting the generated code
2 |
3 | This lesson demonstrates how to inspect what the Halide compiler is producing.
4 |
5 | Since this README is also a literate Haskell file, we start with a few common imports.
6 |
7 | ```haskell
8 | {-# LANGUAGE OverloadedStrings, TypeApplications #-}
9 | import Control.Exception (evaluate)
10 | import Data.Text.IO (hPutStr)
11 | import System.IO (withFile, IOMode (..))
12 | import Test.Hspec
13 |
14 | import Language.Halide hiding (evaluate)
15 | ```
16 |
17 | We'll start by defining the simple single-stage imaging pipeline from [Tutorial 1](../01-Basics).
18 |
19 | This lesson will be about debugging, but unfortunately in Haskell, objects
20 | don't know their own names, which makes it hard for us to understand the
21 | generated code. To get around this, we specify names as `Text` when
22 | constructing `Func` and `Var` objects.
23 |
24 | ```haskell
25 | main :: IO ()
26 | main = hspec $ specify "Tutorial 3" $ do
27 | x <- mkVar "x"
28 | y <- mkVar "y"
29 | gradient <- define "gradient" (x, y) $ x + y
30 | ```
31 |
32 | Realize the function to produce an output image. We'll keep it very small for
33 | this lesson. We also won't need the result, so we tell Halide to do nothing
34 | with the generated buffer.
35 |
36 | ```haskell
37 | realize gradient [8, 8] $ const (pure ())
38 | ```
39 |
40 | That line compiled and ran the pipeline. Try running this lesson with the
41 | environment variable `HL_DEBUG_CODEGEN` set to 1. It will print out the various
42 | stages of compilation, and a pseudocode representation of the final pipeline.
43 |
44 | Generated output
45 |
46 | ```
47 | Creating initial loop nests...
48 | Injecting realization of { gradient }
49 | Skipping injecting memoization...
50 | Injecting tracing...
51 | Adding checks for parameters
52 | Computing bounds of each function's value
53 | Clamping unsafe data-dependent accesses
54 | Performing computation bounds inference...
55 | Removing extern loops...
56 | Performing sliding window optimization...
57 | Uniquifying variable names...
58 | Simplifying...
59 | Simplifying correlated differences...
60 | Performing allocation bounds inference...
61 | Adding checks for images
62 | Removing code that depends on undef values...
63 | Performing storage folding optimization...
64 | Injecting debug_to_file calls...
65 | Injecting prefetches...
66 | Discarding safe promises...
67 | Dynamically skipping stages...
68 | Forking asynchronous producers...
69 | Destructuring tuple-valued realizations...
70 | Bounding small realizations...
71 | Performing storage flattening...
72 | Adding atomic mutex allocation...
73 | Unpacking buffer arguments...
74 | Skipping rewriting memoized allocations...
75 | Simplifying...
76 | Reduce prefetch dimension...
77 | Simplifying correlated differences...
78 | Unrolling...
79 | Vectorizing...
80 | Detecting vector interleavings...
81 | Partitioning loops to simplify boundary conditions...
82 | Staging strided loads...
83 | Trimming loops to the region over which they do something...
84 | Rebasing loops to zero...
85 | Hoisting loop invariant if statements...
86 | Injecting early frees...
87 | Simplifying correlated differences...
88 | Bounding small allocations...
89 | Simplifying...
90 | Lowering unsafe promises...
91 | Flattening nested ramps...
92 | Removing dead allocations and moving loop invariant code...
93 | Finding intrinsics...
94 | Hoisting prefetches...
95 | Lowering after final simplification:
96 | assert(reinterpret((struct halide_buffer_t *)gradient.buffer) != (uint64)0, halide_error_buffer_argument_is_null("gradient"))
97 | let gradient = (void *)_halide_buffer_get_host((struct halide_buffer_t *)gradient.buffer)
98 | let gradient.type = (uint32)_halide_buffer_get_type((struct halide_buffer_t *)gradient.buffer)
99 | let gradient.device_dirty = (uint1)_halide_buffer_get_device_dirty((struct halide_buffer_t *)gradient.buffer)
100 | let gradient.dimensions = _halide_buffer_get_dimensions((struct halide_buffer_t *)gradient.buffer)
101 | let gradient.min.0 = _halide_buffer_get_min((struct halide_buffer_t *)gradient.buffer, 0)
102 | let gradient.extent.0 = _halide_buffer_get_extent((struct halide_buffer_t *)gradient.buffer, 0)
103 | let gradient.stride.0 = _halide_buffer_get_stride((struct halide_buffer_t *)gradient.buffer, 0)
104 | let gradient.min.1 = _halide_buffer_get_min((struct halide_buffer_t *)gradient.buffer, 1)
105 | let gradient.extent.1 = _halide_buffer_get_extent((struct halide_buffer_t *)gradient.buffer, 1)
106 | let gradient.stride.1 = _halide_buffer_get_stride((struct halide_buffer_t *)gradient.buffer, 1)
107 | if ((uint1)_halide_buffer_is_bounds_query((struct halide_buffer_t *)gradient.buffer)) {
108 | (struct halide_buffer_t *)_halide_buffer_init((struct halide_buffer_t *)gradient.buffer, (struct halide_dimension_t *)_halide_buffer_get_shape((struct halide_buffer_t *)gradient.buffer), reinterpret<(void *)>((uint64)0), (uint64)0, reinterpret<(struct halide_device_interface_t *)>((uint64)0), 0, 32, 2, (struct halide_dimension_t *)make_struct(gradient.min.0, gradient.extent.0, 1, 0, gradient.min.1, gradient.extent.1, gradient.extent.0, 0), (uint64)0)
109 | }
110 | if (!(uint1)_halide_buffer_is_bounds_query((struct halide_buffer_t *)gradient.buffer)) {
111 | assert(gradient.type == (uint32)73728, halide_error_bad_type("Output buffer gradient", gradient.type, (uint32)73728))
112 | assert(gradient.dimensions == 2, halide_error_bad_dimensions("Output buffer gradient", gradient.dimensions, 2))
113 | assert(0 <= gradient.extent.0, halide_error_buffer_extents_negative("Output buffer gradient", 0, gradient.extent.0))
114 | assert(0 <= gradient.extent.1, halide_error_buffer_extents_negative("Output buffer gradient", 1, gradient.extent.1))
115 | assert(gradient.stride.0 == 1, halide_error_constraint_violated("gradient.stride.0", gradient.stride.0, "1", 1))
116 | let gradient.total_extent.1 = int64(gradient.extent.1)*int64(gradient.extent.0)
117 | assert(uint64(gradient.extent.0) <= (uint64)2147483647, halide_error_buffer_allocation_too_large("gradient", uint64(gradient.extent.0), (uint64)2147483647))
118 | assert((uint64)abs(int64(gradient.extent.1)*int64(gradient.stride.1)) <= (uint64)2147483647, halide_error_buffer_allocation_too_large("gradient", (uint64)abs(int64(gradient.extent.1)*int64(gradient.stride.1)), (uint64)2147483647))
119 | assert(gradient.total_extent.1 <= (int64)2147483647, halide_error_buffer_extents_too_large("gradient", gradient.total_extent.1, (int64)2147483647))
120 | assert(!gradient.device_dirty, halide_error_device_dirty_with_no_device_support("Output buffer gradient"))
121 | assert(gradient != reinterpret<(void *)>((uint64)0), halide_error_host_is_null("Output buffer gradient"))
122 | produce gradient {
123 | let t2 = 0 - (gradient.min.1*gradient.stride.1)
124 | let t1 = gradient.min.0 + gradient.min.1
125 | for (gradient.s0.y.rebased, 0, gradient.extent.1) {
126 | let t4 = ((gradient.min.1 + gradient.s0.y.rebased)*gradient.stride.1) + t2
127 | let t3 = gradient.s0.y.rebased + t1
128 | for (gradient.s0.x.rebased, 0, gradient.extent.0) {
129 | gradient[gradient.s0.x.rebased + t4] = gradient.s0.x.rebased + t3
130 | }
131 | }
132 | }
133 | }
134 |
135 | Skipping Hexagon offload...
136 | Skipping GPU offload...
137 | Lowering Parallel Tasks...
138 | Target triple of initial module: x86_64--linux-gnu
139 | Generating llvm bitcode...
140 | Generating llvm bitcode prolog for function gradient...
141 | Generating llvm bitcode for function gradient...
142 | JIT compiling shared runtime for x86-64-linux-avx-avx2-f16c-fma-jit-sse41-user_context
143 | JIT compiling gradient for x86-64-linux-avx-avx2-f16c-fma-jit-sse41-user_context
144 | ```
145 |
146 |
147 |
148 | If you set `HL_DEBUG_CODEGEN` to a higher number, you can see more and more
149 | details of how Halide compiles your pipeline. Setting `HL_DEBUG_CODEGEN=2` shows
150 | the Halide code at each stage of compilation, and also the llvm bitcode we
151 | generate at the end.
152 |
153 | Halide can also output an HTML version of this output, which supports syntax
154 | highlighting and code-folding, so it can be nicer to read for large pipelines.
155 | Open `gradient.html` with your browser after running this tutorial.
156 |
157 | ```haskell
158 | withFile "gradient.html" WriteMode $ \h ->
159 | hPutStr h =<< compileToLoweredStmt StmtHTML hostTarget (evaluate gradient)
160 | ```
161 |
162 | You can usually figure out what code Halide is generating using this
163 | pseudocode. In the next lesson we'll see how to snoop on Halide at runtime.
164 |
--------------------------------------------------------------------------------
/tutorials/03-Inspecting/halide-tutorial03.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-tutorial03
3 | version: 0.0.1.0
4 | license: BSD-3-Clause
5 | author: twesterhout
6 | maintainer: 14264576+twesterhout@users.noreply.github.com
7 | build-type: Simple
8 |
9 | common setup
10 | ghc-options: -W -pgmL markdown-unlit
11 | default-language: GHC2021
12 | build-depends:
13 | , base >=4.16.0.0 && <5
14 | , halide-haskell
15 | , hspec
16 | , text
17 | , vector
18 |
19 | -- build-tools-depends: markdown-unlit:exe:markdown-unlit
20 |
21 | executable halide-tutorial03
22 | import: setup
23 | main-is: README.lhs
24 | hs-source-dirs: .
25 |
26 | test-suite halide-tutorial03-test
27 | import: setup
28 | main-is: README.lhs
29 | type: exitcode-stdio-1.0
30 |
--------------------------------------------------------------------------------
/tutorials/04-Debugging/README.lhs:
--------------------------------------------------------------------------------
1 | README.md
--------------------------------------------------------------------------------
/tutorials/04-Debugging/README.md:
--------------------------------------------------------------------------------
1 | # Debugging with tracing, `printed`, and `printedWhen`
2 |
3 | This lesson demonstrates how to follow what Halide is doing at runtime.
4 |
5 | Since this README is also a literate Haskell file, we start with a few common imports.
6 |
7 | ```haskell
8 | {-# LANGUAGE OverloadedStrings, TypeApplications #-}
9 | import Control.Monad (void)
10 | import Data.Text (Text)
11 | import Test.Hspec hiding (parallel)
12 |
13 | import Language.Halide hiding (evaluate, mod, div)
14 | import Prelude hiding (and)
15 | ```
16 |
17 | ### Printing out the value of Funcs as they are computed.
18 |
19 | We'll define our gradient function as before.
20 |
21 | ```haskell
22 | main :: IO ()
23 | main = hspec $ describe "Tutorial 4" $ do
24 | it "Prints the value of Funcs when the are computed" $ do
25 | x <- mkVar "x"
26 | y <- mkVar "y"
27 | gradient <- define "gradient" (x, y) $ x + y
28 | ```
29 |
30 | And tell Halide that we'd like to be notified of all evaluations.
31 |
32 | ```haskell
33 | traceStores gradient
34 | ```
35 |
36 | Realize the function over an 8x8 region.
37 |
38 | ```haskell
39 | putStrLn "Evaluating gradient ..."
40 | realize gradient [8, 8] . const $ pure ()
41 | ```
42 |
43 |
44 | Show output...
45 |
46 | ```
47 | Begin pipeline gradient.0()
48 | Tag gradient.0() tag = "func_type_and_dim: 1 0 32 1 2 0 8 0 8"
49 | Store gradient.0(0, 0) = 0
50 | Store gradient.0(1, 0) = 1
51 | Store gradient.0(2, 0) = 2
52 | Store gradient.0(3, 0) = 3
53 | Store gradient.0(4, 0) = 4
54 | Store gradient.0(5, 0) = 5
55 | Store gradient.0(6, 0) = 6
56 | Store gradient.0(7, 0) = 7
57 | Store gradient.0(0, 1) = 1
58 | Store gradient.0(1, 1) = 2
59 | Store gradient.0(2, 1) = 3
60 | Store gradient.0(3, 1) = 4
61 | Store gradient.0(4, 1) = 5
62 | Store gradient.0(5, 1) = 6
63 | Store gradient.0(6, 1) = 7
64 | Store gradient.0(7, 1) = 8
65 | Store gradient.0(0, 2) = 2
66 | Store gradient.0(1, 2) = 3
67 | Store gradient.0(2, 2) = 4
68 | Store gradient.0(3, 2) = 5
69 | Store gradient.0(4, 2) = 6
70 | Store gradient.0(5, 2) = 7
71 | Store gradient.0(6, 2) = 8
72 | Store gradient.0(7, 2) = 9
73 | Store gradient.0(0, 3) = 3
74 | Store gradient.0(1, 3) = 4
75 | Store gradient.0(2, 3) = 5
76 | Store gradient.0(3, 3) = 6
77 | Store gradient.0(4, 3) = 7
78 | Store gradient.0(5, 3) = 8
79 | Store gradient.0(6, 3) = 9
80 | Store gradient.0(7, 3) = 10
81 | Store gradient.0(0, 4) = 4
82 | Store gradient.0(1, 4) = 5
83 | Store gradient.0(2, 4) = 6
84 | Store gradient.0(3, 4) = 7
85 | Store gradient.0(4, 4) = 8
86 | Store gradient.0(5, 4) = 9
87 | Store gradient.0(6, 4) = 10
88 | Store gradient.0(7, 4) = 11
89 | Store gradient.0(0, 5) = 5
90 | Store gradient.0(1, 5) = 6
91 | Store gradient.0(2, 5) = 7
92 | Store gradient.0(3, 5) = 8
93 | Store gradient.0(4, 5) = 9
94 | Store gradient.0(5, 5) = 10
95 | Store gradient.0(6, 5) = 11
96 | Store gradient.0(7, 5) = 12
97 | Store gradient.0(0, 6) = 6
98 | Store gradient.0(1, 6) = 7
99 | Store gradient.0(2, 6) = 8
100 | Store gradient.0(3, 6) = 9
101 | Store gradient.0(4, 6) = 10
102 | Store gradient.0(5, 6) = 11
103 | Store gradient.0(6, 6) = 12
104 | Store gradient.0(7, 6) = 13
105 | Store gradient.0(0, 7) = 7
106 | Store gradient.0(1, 7) = 8
107 | Store gradient.0(2, 7) = 9
108 | Store gradient.0(3, 7) = 10
109 | Store gradient.0(4, 7) = 11
110 | Store gradient.0(5, 7) = 12
111 | Store gradient.0(6, 7) = 13
112 | Store gradient.0(7, 7) = 14
113 | End pipeline gradient.0()
114 | ```
115 |
116 |
117 |
118 | This will print out all the times `gradient(x, y)` gets evaluated.
119 |
120 | Now that we can snoop on what Halide is doing, let's try our first scheduling
121 | primitive. We'll make a new version of gradient that processes each scanline in
122 | parallel.
123 |
124 | ```haskell
125 | parallelGradient <- define "parallelGradient" (x, y) $ x + y
126 | ```
127 |
128 | We'll also trace this function.
129 |
130 | ```haskell
131 | traceStores parallelGradient
132 | ```
133 |
134 | Things are the same so far. We've defined the algorithm, but haven't said
135 | anything about how to schedule it. In general, exploring different scheduling
136 | decisions doesn't change the code that describes the algorithm.
137 |
138 | Now we tell Halide to use a parallel for loop over the y coordinate. On Linux
139 | we run this using a thread pool and a task queue. On OS X we call into grand
140 | central dispatch, which does the same thing for us.
141 |
142 | ```haskell
143 | void $ parallel y parallelGradient
144 | ```
145 |
146 | This time the printfs should come out of order, because each scanline is
147 | potentially being processed in a different thread. The number of threads should
148 | adapt to your system, but on linux you can control it manually using the
149 | environment variable `HL_NUM_THREADS`.
150 |
151 | ```haskell
152 | putStrLn "Evaluating parallelGradient ..."
153 | realize parallelGradient [8, 8] . const $ pure ()
154 | ```
155 |
156 |
157 | Show output...
158 |
159 | ```
160 | Evaluating parallelGradient ...
161 | Begin pipeline parallelGradient.0()
162 | Tag parallelGradient.0() tag = "func_type_and_dim: 1 0 32 1 2 0 8 0 8"
163 | Store parallelGradient.0(0, 0) = 0
164 | Store parallelGradient.0(1, 0) = 1
165 | Store parallelGradient.0(2, 0) = 2
166 | Store parallelGradient.0(3, 0) = 3
167 | Store parallelGradient.0(4, 0) = 4
168 | Store parallelGradient.0(5, 0) = 5
169 | Store parallelGradient.0(6, 0) = 6
170 | Store parallelGradient.0(7, 0) = 7
171 | Store parallelGradient.0(0, 4) = 4
172 | Store parallelGradient.0(1, 4) = 5
173 | Store parallelGradient.0(2, 4) = 6
174 | Store parallelGradient.0(3, 4) = 7
175 | Store parallelGradient.0(4, 4) = 8
176 | Store parallelGradient.0(5, 4) = 9
177 | Store parallelGradient.0(6, 4) = 10
178 | Store parallelGradient.0(7, 4) = 11
179 | Store parallelGradient.0(0, 3) = 3
180 | Store parallelGradient.0(1, 3) = 4
181 | Store parallelGradient.0(2, 3) = 5
182 | Store parallelGradient.0(3, 3) = 6
183 | Store parallelGradient.0(4, 3) = 7
184 | Store parallelGradient.0(5, 3) = 8
185 | Store parallelGradient.0(6, 3) = 9
186 | Store parallelGradient.0(7, 3) = 10
187 | Store parallelGradient.0(0, 7) = 7
188 | Store parallelGradient.0(0, 5) = 5
189 | Store parallelGradient.0(0, 6) = 6
190 | Store parallelGradient.0(1, 7) = 8
191 | Store parallelGradient.0(1, 5) = 6
192 | Store parallelGradient.0(2, 5) = 7
193 | Store parallelGradient.0(1, 6) = 7
194 | Store parallelGradient.0(2, 7) = 9
195 | Store parallelGradient.0(3, 5) = 8
196 | Store parallelGradient.0(2, 6) = 8
197 | Store parallelGradient.0(3, 7) = 10
198 | Store parallelGradient.0(4, 5) = 9
199 | Store parallelGradient.0(4, 7) = 11
200 | Store parallelGradient.0(5, 5) = 10
201 | Store parallelGradient.0(3, 6) = 9
202 | Store parallelGradient.0(5, 7) = 12
203 | Store parallelGradient.0(6, 5) = 11
204 | Store parallelGradient.0(4, 6) = 10
205 | Store parallelGradient.0(6, 7) = 13
206 | Store parallelGradient.0(5, 6) = 11
207 | Store parallelGradient.0(7, 5) = 12
208 | Store parallelGradient.0(7, 7) = 14
209 | Store parallelGradient.0(6, 6) = 12
210 | Store parallelGradient.0(7, 6) = 13
211 | Store parallelGradient.0(0, 1) = 1
212 | Store parallelGradient.0(1, 1) = 2
213 | Store parallelGradient.0(2, 1) = 3
214 | Store parallelGradient.0(3, 1) = 4
215 | Store parallelGradient.0(4, 1) = 5
216 | Store parallelGradient.0(5, 1) = 6
217 | Store parallelGradient.0(6, 1) = 7
218 | Store parallelGradient.0(7, 1) = 8
219 | Store parallelGradient.0(0, 2) = 2
220 | Store parallelGradient.0(1, 2) = 3
221 | Store parallelGradient.0(2, 2) = 4
222 | Store parallelGradient.0(3, 2) = 5
223 | Store parallelGradient.0(4, 2) = 6
224 | Store parallelGradient.0(5, 2) = 7
225 | Store parallelGradient.0(6, 2) = 8
226 | Store parallelGradient.0(7, 2) = 9
227 | End pipeline parallelGradient.0()
228 | ```
229 |
230 |
231 |
232 |
233 | ### Printing individual Exprs.
234 |
235 | `traceStores` can only print the value of a `Func`. Sometimes you want to
236 | inspect the value of sub-expressions rather than the entire `Func`. The
237 | function `printed` can be wrapped around any `Expr` to print the value of that
238 | `Expr` every time it is evaluated.
239 |
240 | For example, say we have some `Func` that is the sum of two terms:
241 |
242 | ```haskell
243 | it "Prints individual Exprs" $ do
244 | x <- mkVar "x"
245 | y <- mkVar "y"
246 | f <- define "f" (x, y) $ sin (cast @Float x) + cos (cast @Float y)
247 | ```
248 |
249 | If we want to inspect just one of the terms, we can wrap it in a call to `printed`:
250 |
251 | ```haskell
252 | g <- define "g" (x, y) $ sin (cast @Float x) + printed (cos (cast @Float y))
253 | putStrLn "Evaluating sin(x) + cos(y), and just printing cos(y)..."
254 | realize g [4, 4] . const $ pure ()
255 | ```
256 |
257 |
258 | Show output...
259 |
260 | ```
261 | 1.000000
262 | 1.000000
263 | 1.000000
264 | 1.000000
265 | 0.540302
266 | 0.540302
267 | 0.540302
268 | 0.540302
269 | -0.416147
270 | -0.416147
271 | -0.416147
272 | -0.416147
273 | -0.989992
274 | -0.989992
275 | -0.989992
276 | -0.989992
277 | ```
278 |
279 |
280 |
281 |
282 | ### Printing additional context
283 |
284 | `printed` can take multiple arguments. It prints all of them and evaluates to
285 | the first one. The arguments can be `Expr`s, `Text`, or `String`. This can be
286 | used to print additional context alongside the value:
287 |
288 | ```haskell
289 | it "Prints additional context" $ do
290 | x <- mkVar "x"
291 | y <- mkVar "y"
292 | let second = printed (cos (cast @Float y)) ("<- this is cos(" :: Text) y (") when x =" :: Text) x
293 | f <- define "f" (x, y) $ sin (cast @Float x) + second
294 | putStrLn "Evaluating sin(x) + cos(y), and printing cos(y) with more context..."
295 | realize f [4, 4] . const $ pure ()
296 | ```
297 |
298 |
299 | Show output...
300 |
301 | ```
302 | 1.000000 <- this is cos( 0 ) when x = 0
303 | 1.000000 <- this is cos( 0 ) when x = 1
304 | 1.000000 <- this is cos( 0 ) when x = 2
305 | 1.000000 <- this is cos( 0 ) when x = 3
306 | 0.540302 <- this is cos( 1 ) when x = 0
307 | 0.540302 <- this is cos( 1 ) when x = 1
308 | 0.540302 <- this is cos( 1 ) when x = 2
309 | 0.540302 <- this is cos( 1 ) when x = 3
310 | -0.416147 <- this is cos( 2 ) when x = 0
311 | -0.416147 <- this is cos( 2 ) when x = 1
312 | -0.416147 <- this is cos( 2 ) when x = 2
313 | -0.416147 <- this is cos( 2 ) when x = 3
314 | -0.989992 <- this is cos( 3 ) when x = 0
315 | -0.989992 <- this is cos( 3 ) when x = 1
316 | -0.989992 <- this is cos( 3 ) when x = 2
317 | -0.989992 <- this is cos( 3 ) when x = 3
318 | ```
319 |
320 |
321 |
322 |
323 | ### Conditional printing
324 |
325 | Both `printed` and `traceStores` can produce a lot of output. If you're looking for
326 | a rare event, or just want to see what happens at a single pixel, this amount
327 | of output can be difficult to dig through. Instead, the function `printedWhen` can
328 | be used to conditionally print an `Expr`. The first argument to `printedWhen`
329 | is an `Expr Bool`. If the `Expr` evaluates to `True`, it returns the second
330 | argument and prints all of the arguments. If the `Expr` evaluates to `False` it
331 | just returns the second argument and does not print.
332 |
333 | ```haskell
334 | it "Conditionally prints Exprs" $ do
335 | x <- mkVar "x"
336 | y <- mkVar "y"
337 | let e = printedWhen (eq x 37 `and` eq y 42) (cos (cast @Float y)) ("<- this is cos(y) at x, y == (37, 42)" :: Text)
338 | f <- define "f" (x, y) $ sin (cast @Float x) + e
339 | putStrLn $ "Evaluating sin(x) + cos(y), and printing cos(y) at a single pixel..."
340 | realize f [640, 480] . const $ pure ()
341 | ```
342 |
343 |
344 | Show output...
345 |
346 | ```
347 | -0.399985 <- this is cos(y) at x, y == (37, 42)
348 | ```
349 |
350 |
351 |
352 | `printedWhen` can also be used to check for values you're not expecting:
353 |
354 | ```haskell
355 | let e = cos (cast @Float y)
356 | e' = printedWhen (e `lt` 0) e ("cos(y) < 0 at y ==" :: Text) y
357 | g <- define "g" (x, y) $ sin (cast @Float x) + e'
358 | putStrLn $ "Evaluating sin(x) + cos(y), and printing whenever cos(y) < 0..."
359 | realize g [4, 4] . const $ pure ()
360 | ```
361 |
362 |
363 | Show output...
364 |
365 | ```
366 | -0.416147 cos(y) < 0 at y == 2
367 | -0.416147 cos(y) < 0 at y == 2
368 | -0.416147 cos(y) < 0 at y == 2
369 | -0.416147 cos(y) < 0 at y == 2
370 | -0.989992 cos(y) < 0 at y == 3
371 | -0.989992 cos(y) < 0 at y == 3
372 | -0.989992 cos(y) < 0 at y == 3
373 | -0.989992 cos(y) < 0 at y == 3
374 | ```
375 |
376 |
377 |
378 |
379 | ### Printing expressions at compile-time.
380 |
381 | The code below builds up a Halide expression across several lines of code. If
382 | you're programmatically constructing a complex expression, and you want to
383 | check the expression you've created is what you think it is, you can also print
384 | out the expression itself the `Show` typeclass:
385 |
386 | ```haskell
387 | it "Prints expressions at compile-time" $ do
388 | fizz <- mkVar "fizz"
389 | buzz <- mkVar "buzz"
390 | let combine e i
391 | | i `mod` 3 == 0 && i `mod` 5 == 0 = e + fizz * buzz
392 | | i `mod` 3 == 0 = e + fizz
393 | | i `mod` 5 == 0 = e + buzz
394 | | otherwise = e + mkExpr i
395 | let e = foldl combine 1 [2 .. 99]
396 | print e
397 | ```
398 |
399 |
400 | Show output...
401 |
402 | ```
403 | ((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((1 + 2) + fizz) + 4) + buzz) + fizz) + 7) + 8) + fizz) + buzz) + 11) + fizz) + 13) + 14) + (fizz*buzz)) + 16) + 17) + fizz) + 19) + buzz) + fizz) + 22) + 23) + fizz) + buzz) + 26) + fizz) + 28) + 29) + (fizz*buzz)) + 31) + 32) + fizz) + 34) + buzz) + fizz) + 37) + 38) + fizz) + buzz) + 41) + fizz) + 43) + 44) + (fizz*buzz)) + 46) + 47) + fizz) + 49) + buzz) + fizz) + 52) + 53) + fizz) + buzz) + 56) + fizz) + 58) + 59) + (fizz*buzz)) + 61) + 62) + fizz) + 64) + buzz) + fizz) + 67) + 68) + fizz) + buzz) + 71) + fizz) + 73) + 74) + (fizz*buzz)) + 76) + 77) + fizz) + 79) + buzz) + fizz) + 82) + 83) + fizz) + buzz) + 86) + fizz) + 88) + 89) + (fizz*buzz)) + 91) + 92) + fizz) + 94) + buzz) + fizz) + 97) + 98) + fizz)
404 | ```
405 |
406 |
407 |
--------------------------------------------------------------------------------
/tutorials/04-Debugging/halide-tutorial04.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-tutorial04
3 | version: 0.0.1.0
4 | license: BSD-3-Clause
5 | author: twesterhout
6 | maintainer: 14264576+twesterhout@users.noreply.github.com
7 | build-type: Simple
8 |
9 | common setup
10 | ghc-options: -W -pgmL markdown-unlit
11 | default-language: GHC2021
12 | build-depends:
13 | , base >=4.16.0.0 && <5
14 | , halide-haskell
15 | , hspec
16 | , text
17 | , vector
18 |
19 | -- build-tools-depends: markdown-unlit:exe:markdown-unlit
20 |
21 | executable halide-tutorial04
22 | import: setup
23 | main-is: README.lhs
24 | hs-source-dirs: .
25 |
26 | test-suite halide-tutorial04-test
27 | import: setup
28 | main-is: README.lhs
29 | type: exitcode-stdio-1.0
30 |
--------------------------------------------------------------------------------
/tutorials/05-Scheduling/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2023, twesterhout
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of twesterhout nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 |
--------------------------------------------------------------------------------
/tutorials/05-Scheduling/README.lhs:
--------------------------------------------------------------------------------
1 | README.md
--------------------------------------------------------------------------------
/tutorials/05-Scheduling/README.md:
--------------------------------------------------------------------------------
1 | # Vectorize, parallelize, unroll and tile your code
2 |
3 | This lesson demonstrates how to manipulate the order in which you evaluate
4 | pixels in a `Func`, including vectorization, parallelization, unrolling, and
5 | tiling.
6 |
7 | Because this README is also a literate Haskell file, we start with a few common imports.
8 |
9 | ```haskell
10 | {-# LANGUAGE OverloadedStrings, TypeApplications, DataKinds #-}
11 | import Control.Monad (void)
12 | import Data.Text (Text, pack)
13 | import Data.Text.IO (hPutStrLn)
14 | import System.IO (stderr)
15 | import Test.Hspec hiding (parallel)
16 |
17 | import Language.Halide
18 | ```
19 |
20 | We're going to define and schedule our gradient function in several different
21 | ways, and see what order pixels are computed in. For this, we define a helper
22 | function such that we don't have to constantly repeat the definition of it.
23 |
24 | ```haskell
25 | prepare :: IO (Expr Int32, Expr Int32, Func 'FuncTy 2 (Expr Int32))
26 | prepare = do
27 | x <- mkVar "x"
28 | y <- mkVar "y"
29 | gradient <- define "gradient" (x, y) $ x + y
30 | pure (x, y, gradient)
31 | ```
32 |
33 | We also define a helper function to evaluate a `Func` and collect the order of
34 | stores performed by the function. We will use it for testing.
35 |
36 | ```haskell
37 | getIterationOrder :: (KnownNat n, IsHalideType a) => [Int] -> Func t n (Expr a) -> IO [[Int]]
38 | getIterationOrder shape f =
39 | fmap fst $
40 | collectIterationOrder (TraceStore ==) f $ do
41 | _ <- traceStores f
42 | realize f shape (void . pure)
43 | ```
44 |
45 | Finally, we define a helper function to dump `Text` to stderr.
46 |
47 | ```haskell
48 | toStderr :: Text -> IO ()
49 | toStderr a = hPutStrLn stderr ("\n" <> a)
50 | ```
51 |
52 | ## Default
53 |
54 | By default, Halide traverses arrays in column-major order. That means that the
55 | loop over x happens first, and then the loop over y. This can be visualized
56 | using the `prettyLoopNest` function:
57 |
58 | ```haskell
59 | main :: IO ()
60 | main = hspec $ describe "Tutorial 5" $ do
61 | it "Has column-major ordering by default" $ do
62 | (_, _, gradient) <- prepare
63 | toStderr =<< prettyLoopNest gradient
64 | ```
65 |
66 | This produces:
67 |
68 | ```
69 | produce gradient:
70 | for y:
71 | for x:
72 | gradient(...) = ...
73 | ```
74 |
75 | Let's make sure that the function actually computes what we want:
76 |
77 | ```haskell
78 | realize gradient [4, 4] peekToList
79 | `shouldReturn` [[i + j | j <- [0 .. 3]] | i <- [0 .. 3]]
80 | ```
81 |
82 | `realize` function evaluates our pipeline over a rectangular domain -- in our
83 | case a 4x4 buffer, and `peekToList` then reads the contents of the buffer into
84 | a nested list.
85 |
86 | We check our assumption about the iteration order by building the expected
87 | iteration order using standard list comprehensions:
88 |
89 | ```haskell
90 | getIterationOrder [4, 4] gradient
91 | `shouldReturn` [[i, j] | j <- [0 .. 3], i <- [0 .. 3]]
92 | ```
93 |
94 | ## Reorder
95 |
96 | If we reorder `x` and `y`, we can walk along the rows instead. The `reorder` call takes the
97 | arguments of the func, and sets a new nesting order for the for loops that are generated.
98 | The arguments are specified from the innermost loop out, so the following puts `y` in
99 | the inner loop:
100 |
101 | ```haskell
102 | it "Reorders loops to have row-major order" $ do
103 | (x, y, gradient) <- prepare
104 | void $ reorder [y, x] gradient
105 | toStderr =<< prettyLoopNest gradient
106 | getIterationOrder [4, 4] gradient
107 | `shouldReturn` [[i, j] | i <- [0 .. 3], j <- [0 .. 3]]
108 | ```
109 |
110 | And the loop nest now reads
111 |
112 | ```
113 | produce gradient:
114 | for x:
115 | for y:
116 | gradient(...) = ...
117 | ```
118 |
119 | ## Split
120 |
121 | The most powerful primitive scheduling operation you can do to a var is to split it into
122 | inner and outer sub-variables:
123 |
124 | ```haskell
125 | it "Splits a variable into two" $ do
126 | (x, _, gradient) <- prepare
127 | inner <- mkVar "inner"
128 | outer <- mkVar "outer"
129 | void $ split TailAuto x (outer, inner) 2 gradient
130 | toStderr =<< prettyLoopNest gradient
131 | ```
132 |
133 | This breaks the loop over `x` into two nested loops: an outer one over outer, and an inner
134 | one over inner. We have also specified the "split factor". The inner loop runs from zero
135 | to the split factor. The outer loop runs from zero to the extent required of `x` (4 in this case)
136 | divided by the split factor. Within the loops, the old variable is defined to be
137 | `outer * factor + inner`. If the old loop started at a value other than zero, then that is
138 | also added within the loops.
139 |
140 | ```
141 | produce gradient:
142 | for y:
143 | for x.outer:
144 | for x.inner in [0, 1]:
145 | gradient(...) = ...
146 | ```
147 |
148 | Note that the order of evaluation of pixels didn't actually change! Splitting by itself does
149 | nothing, but it does open up all of the scheduling possibilities that we will explore below.
150 |
151 | ```haskell
152 | getIterationOrder [4, 4] gradient
153 | `shouldReturn` [[i, j] | j <- [0 .. 3], i <- [0 .. 3]]
154 | ```
155 |
156 | ## Fuse
157 |
158 | The opposite of splitting is fusing. Fusing two variables merges the two loops into
159 | a single for loop over the product of the extents. Fusing is less important than splitting,
160 | but it also sees use (as we'll see later in this lesson). Like splitting, fusing by itself
161 | doesn't change the order of evaluation.
162 |
163 | ```haskell
164 | it "Fuses two variables into one" $ do
165 | (x, y, gradient) <- prepare
166 | fused <- mkVar "fused"
167 | void $ fuse (x, y) fused gradient
168 | toStderr =<< prettyLoopNest gradient
169 |
170 | getIterationOrder [4, 4] gradient
171 | `shouldReturn` [[i, j] | j <- [0 .. 3], i <- [0 .. 3]]
172 | ```
173 |
174 | ```
175 | produce gradient:
176 | for x.fused:
177 | gradient(...) = ...
178 | ```
179 |
180 | ## Tile
181 |
182 | Now that we can both split and reorder, we can do tiled evaluation. Let's split both
183 | x and y by a factor of four, and then reorder the vars to express a tiled traversal:
184 |
185 | ```haskell
186 | it "Evaluates in tiles" $ do
187 | (x, y, gradient) <- prepare
188 | [xOuter, xInner, yOuter, yInner] <- mapM mkVar ["xOuter", "xInner", "yOuter", "yInner"]
189 | void $
190 | split TailAuto x (xOuter, xInner) 2 gradient
191 | >>= split TailAuto y (yOuter, yInner) 2
192 | >>= reorder [xInner, yInner, xOuter, yOuter]
193 | toStderr =<< prettyLoopNest gradient
194 | ```
195 |
196 | ```
197 | produce gradient:
198 | for y.yOuter:
199 | for x.xOuter:
200 | for y.yInner in [0, 1]:
201 | for x.xInner in [0, 1]:
202 | gradient(...) = ...
203 | ```
204 |
205 | A tiled traversal splits the domain into small rectangular tiles, and outermost iterates
206 | over the tiles, and within that iterates over the points within each tile. It can be good
207 | for performance if neighboring pixels use overlapping input data, for example in a blur.
208 |
209 | ```haskell
210 | getIterationOrder [4, 4] gradient
211 | `shouldReturn` [ [i + 2 * iTile, j + 2 * jTile]
212 | | jTile <- [0 .. 1]
213 | , iTile <- [0 .. 1]
214 | , j <- [0 .. 1]
215 | , i <- [0 .. 1]
216 | ]
217 | ```
218 |
219 | ## Vectorize
220 |
221 | The nice thing about splitting is that it guarantees the inner variable runs from zero
222 | to the split factor. Most of the time the split-factor will be a compile-time constant,
223 | so we can replace the loop over the inner variable with a single vectorized computation.
224 | This time we'll split by a factor of four, because on X86 we can use SSE to compute in
225 | 4-wide vectors.
226 |
227 |
228 | ```haskell
229 | it "Evaluates in vectors" $ do
230 | (x, _, gradient) <- prepare
231 | inner <- mkVar "inner"
232 | void $
233 | split TailAuto x (x, inner) 4 gradient
234 | >>= vectorize inner
235 | toStderr =<< prettyLoopNest gradient
236 | ```
237 |
238 | ```
239 | produce gradient:
240 | for y:
241 | for x.x:
242 | vectorized x.inner in [0, 3]:
243 | gradient(...) = ...
244 | ```
245 |
246 | We can check that the vectorization is reflected in the iteration order. We now expect coordinates to be a
247 | length 8 list instead of length 2. I.e. each element is [x1, x2, x3, x4, y1, y2, y3, y4]. This time we'll evaluate over an 8x4 box, so that we have more than one vector of work per scanline.
248 |
249 | ```haskell
250 | getIterationOrder [8, 4] gradient
251 | `shouldReturn` [ [4 * i .. 4 * i + 3] <> [j, j, j, j]
252 | | j <- [0 .. 3]
253 | , i <- [0 .. 1]
254 | ]
255 | ```
256 |
257 | ## Unroll
258 |
259 | If multiple pixels share overlapping data, it can make sense to unroll a computation
260 | so that shared values are only computed or loaded once. We do this similarly to how we
261 | expressed vectorizing. We split a dimension and then fully unroll the loop of the inner
262 | variable. Unrolling doesn't change the order in which things are evaluated.
263 |
264 | ```haskell
265 | it "Unrolls loops" $ do
266 | (x, _, gradient) <- prepare
267 | inner <- mkVar "inner"
268 | void $
269 | split TailAuto x (x, inner) 2 gradient
270 | >>= unroll inner
271 | toStderr =<< prettyLoopNest gradient
272 |
273 | getIterationOrder [4, 4] gradient
274 | `shouldReturn` [[i, j] | j <- [0 .. 3], i <- [0 .. 3]]
275 |
276 | ```
277 |
278 | ```
279 | produce gradient:
280 | for y:
281 | for x.x:
282 | unrolled x.inner in [0, 1]:
283 | gradient(...) = ...
284 | ```
285 |
286 | ## Split again
287 |
288 | Splitting guarantees that the inner loop runs from zero to the split factor, which is
289 | important for the uses we saw above. So what happens when the total extent we wish to
290 | evaluate x over isn't a multiple of the split factor? We'll split by a factor three,
291 | and we'll evaluate gradient over a 7x2 box instead of the 4x4 box we've been using.
292 |
293 | ```haskell
294 | it "Splits by factors that don't divide the extent" $ do
295 | (x, _, gradient) <- prepare
296 | inner <- mkVar "inner"
297 | void $ split TailAuto x (x, inner) 3 gradient
298 |
299 | order <- getIterationOrder [7, 4] gradient
300 | toStderr . pack . show $ order
301 | ```
302 |
303 | ```
304 | [[0,0],[1,0],[2,0],[3,0],[4,0],[5,0],[4,0],[5,0],[6,0],
305 | [0,1],[1,1],[2,1],[3,1],[4,1],[5,1],[4,1],[5,1],[6,1],
306 | [0,2],[1,2],[2,2],[3,2],[4,2],[5,2],[4,2],[5,2],[6,2],
307 | [0,3],[1,3],[2,3],[3,3],[4,3],[5,3],[4,3],[5,3],[6,3]]
308 | ```
309 |
310 | If you read the output, you'll see that some coordinates were evaluated more than once.
311 | That's generally OK, because pure Halide functions have no side-effects, so it's safe to
312 | evaluate the same point multiple times.
313 |
314 | The general rule is: If we require x from x_min to x_min + x_extent, and we split by a
315 | factor factor, then:
316 |
317 | x_outer runs from 0 to (x_extent + factor - 1)/factor
318 | x_inner runs from 0 to factor
319 | x = min(x_outer * factor, x_extent - factor) + x_inner + x_min
320 |
321 | In our example, x_min was 0, x_extent was 7, and factor was 3.
322 |
323 | ```haskell
324 | order
325 | `shouldBe` [ [iInner + Prelude.min (3 * iOuter) (7 - 3), j]
326 | | j <- [0 .. 3]
327 | , iOuter <- [0 .. 2]
328 | , iInner <- [0 .. 2]
329 | ]
330 | ```
331 |
332 |
333 | ## Parallelize
334 |
335 | We saw in the previous lesson that we can parallelize across a variable. Here we combine
336 | it with fusing and tiling to express a useful pattern - processing tiles in parallel.
337 |
338 | This is where fusing shines. Fusing helps when you want to parallelize across multiple
339 | dimensions without introducing nested parallelism. Nested parallelism (parallel for loops
340 | within parallel for loops) is supported by Halide, but often gives poor performance compared
341 | to fusing the parallel variables into a single parallel for loop.
342 |
343 | ```haskell
344 | it "Fuses, tiles, and parallelizes" $ do
345 | (x, y, gradient) <- prepare
346 | [xOuter, xInner, yOuter, yInner, tileIndex] <-
347 | mapM mkVar ["xOuter", "xInner", "yOuter", "yInner", "tileIndex"]
348 |
349 | void $
350 | split TailAuto x (xOuter, xInner) 4 gradient
351 | >>= split TailAuto y (yOuter, yInner) 4
352 | >>= reorder [xInner, yInner, xOuter, yOuter]
353 | >>= fuse (xOuter, yOuter) tileIndex
354 | >>= parallel tileIndex
355 |
356 | toStderr =<< prettyLoopNest gradient
357 | ```
358 |
359 | ```
360 | produce gradient:
361 | parallel x.xOuter.tileIndex:
362 | for y.yInner in [0, 3]:
363 | for x.xInner in [0, 3]:
364 | gradient(...) = ...
365 | ```
366 |
367 | ## All together now
368 |
369 | Are you ready? We're going to use all of the features above now.
370 |
371 | We'll process 64x64 tiles in parallel.
372 |
373 | ```haskell
374 | it "Puts it all together for ultimate performance!" $ do
375 | (x, y, gradient) <- prepare
376 | [xOuter, yOuter, xInner, yInner, tileIndex] <-
377 | mapM mkVar ["xOuter", "yOuter", "xInner", "yInner", "tileIndex"]
378 | void $
379 | split TailAuto x (xOuter, xInner) 64 gradient
380 | >>= split TailAuto y (yOuter, yInner) 64
381 | >>= reorder [xInner, yInner, xOuter, yOuter]
382 | >>= fuse (xOuter, yOuter) tileIndex
383 | >>= parallel tileIndex
384 | ```
385 |
386 | We'll compute two scanlines at once while we walk across each tile. We'll also vectorize in x.
387 | The easiest way to express this is to recursively tile again within each tile into 4x2 subtiles,
388 | then vectorize the subtiles across x and unroll them across y:
389 |
390 | ```haskell
391 | [xInnerOuter, yInnerOuter, xVectors, yPairs] <-
392 | mapM mkVar ["xInnerOuter", "yInnerOuter", "xVectors", "yPairs"]
393 | void $
394 | split TailAuto xInner (xInnerOuter, xVectors) 4 gradient
395 | >>= split TailAuto yInner (yInnerOuter, yPairs) 2
396 | >>= reorder [xVectors, yPairs, xInnerOuter, yInnerOuter]
397 | >>= vectorize xVectors
398 | >>= unroll yPairs
399 |
400 | toStderr =<< prettyLoopNest gradient
401 | ```
402 |
403 | ```
404 | produce gradient:
405 | parallel x.xOuter.tileIndex:
406 | for y.yInner.yInnerOuter in [0, 31]:
407 | for x.xInner.xInnerOuter in [0, 15]:
408 | unrolled y.yInner.yPairs in [0, 1]:
409 | vectorized x.xInner.xVectors in [0, 3]:
410 | gradient(...) = ...
411 | ```
412 |
413 | Let's check that the result is still as we expect
414 |
415 | ```haskell
416 | realize gradient [350, 250] peekToList
417 | `shouldReturn` [[i + j | j <- [0 .. 249]] | i <- [0 .. 349]]
418 | ```
419 |
--------------------------------------------------------------------------------
/tutorials/05-Scheduling/halide-tutorial05.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 3.0
2 | name: halide-tutorial05
3 | version: 0.0.1.0
4 | license: BSD-3-Clause
5 | license-file: LICENSE
6 | author: twesterhout
7 | maintainer: 14264576+twesterhout@users.noreply.github.com
8 | build-type: Simple
9 |
10 | common setup
11 | ghc-options: -W -pgmL markdown-unlit
12 | default-language: GHC2021
13 | build-depends:
14 | , base >=4.16.0.0 && <5
15 | , halide-haskell
16 | , hspec
17 | , text
18 | , vector
19 |
20 | -- build-tools-depends: markdown-unlit:exe:markdown-unlit
21 |
22 | executable halide-tutorial05
23 | import: setup
24 | main-is: README.lhs
25 | hs-source-dirs: .
26 |
27 | test-suite halide-tutorial05-test
28 | import: setup
29 | main-is: README.lhs
30 | type: exitcode-stdio-1.0
31 |
--------------------------------------------------------------------------------
/tutorials/05-Scheduling/test.hs:
--------------------------------------------------------------------------------
1 | #line 10 "all"
2 | {-# LANGUAGE OverloadedStrings, TypeApplications #-}
3 | import Test.Hspec
4 |
5 | import Language.Halide
6 | #line 21 "all"
7 | prepare :: IO (Expr Int32, Expr Int32, Func 'FuncTy 2 Int32)
8 | prepare = do
9 | x <- mkVar "x"
10 | y <- mkVar "y"
11 | gradient <- define "gradient" (x, y) $ x + y
12 | pure (x, y, gradient)
13 | #line 33 "all"
14 | getIterationOrder :: (KnownNat n, IsHalideType a) => [Int] -> Func t n a -> IO [[Int]]
15 | getIterationOrder shape f =
16 | fmap fst $
17 | collectIterationOrder (TraceStore ==) f $ do
18 | _ <- traceStores f
19 | realize f shape (void . pure)
20 | #line 53 "all"
21 | example01 :: Spec
22 | example01 = it "Has column-major ordering by default" $ do
23 | -- First we observe the default ordering
24 | (_, _, gradient) <- prepare
25 | -- Let's first make sure that the function actually computes what we want
26 | realize gradient [4, 4] peekToList
27 | `shouldReturn` [[i + j | j <- [0 .. 3]] | i <- [0 .. 3]]
28 | -- We check our assumption about the iteration order by building the expected
29 | -- iteration order using standard list comprehensions:
30 | getIterationOrder [4, 4] gradient
31 | `shouldReturn` [[i, j] | j <- [0 .. 3], i <- [0 .. 3]]
32 | #line 73 "all"
33 | main :: IO ()
34 | main = hspec $ specify "Tutorial 1" $ do
35 | x <- mkVar "x"
36 | y <- mkVar "y"
37 |
--------------------------------------------------------------------------------
/tutorials/README.md:
--------------------------------------------------------------------------------
1 | # Tutorials
2 |
3 | - [Getting started with `Func`s, `Var`s, and `Expr`s](./01-Basics)
4 | - [Inspecting the generated code](./03-Inspecting)
5 | - [Debugging with tracing, `printed`, and `printedWhen`](./04-Debugging)
6 | - [Vectorize, parallelize, unroll and tile your code](./05-Scheduling)
7 |
8 | For more, see the [tutorials on the C++ API of Halide](https://halide-lang.org/tutorials/).
9 |
--------------------------------------------------------------------------------